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ABSTRACT 


In  an  attempt  to  bring  the  ML-style  type  inference  to  the  C  programming 
language,  Smith  and  Volpano  developed  a  type  system  for  a  dialect  of  C,  called 
PolyC  [SmV96a]  [SmV96b].  PolyC  extends  C  with  ML-style  polymorphism  and  a 
limited  form  of  higher-order  function. 

Smith  and  Volpano  proved  a  type  soundness  theorem  that  basically  says  that 
evaluation  of  a  well-typed  PolyC  program  cannot  fail  due  to  a  type  mismatch.  The 
type  soundness  proof  is  based  on  an  operational  characterization  of  a  special  kind  of 
semantic  formulation  called  a  natural  semantics.  This  thesis  presents  an  alternative 
semantic  formulation,  called  a  transition  semantics,  that  could  be  used  in  place  of  the 
natural  semantics  to  prove  type  soundness.  The  primary  advantage  of  the  transition 
semantics  is  that  it  eliminates  the  extra  operational  level,  but  the  disadvantage  is 
that  it  consists  of  many  more  evaluation  rules  than  the  natural  semantics.  Thus,  it 
is  unclear  whether  it  is  a  suitable  alternative  to  the  two-level  approach  of  Smith  and 
Volpano. 

Further,  the  thesis  gives  the  first  full  type  inference  algorithm  for  the  type 
system  of  PolyC.  Despite  implicit  variable  dereferencing  found  in  PolyC,  the  algorithm 
turns  out  to  be  a  rather  straightforward  extension  of  Damas  and  Milner's  algorithm 
W  for  functional  languages  [DaM82].  The  algorithm  has  been  implemented  as  an 
attribute  grammar  in  Grammatech's  SSL  and  a  complete  source  code  listing  is  given 
in  the  Appendix. 


VI 


DISCLAIMER 

The  computer  program  in  the  Appendix  is  supplied  on  an  "as  is"  basis,  with 
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of  using  this  program. 
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I.         INTRODUCTION 

If  one  studies  some  of  the  well-known  algorithms  in  Computer  Science  carefully, 
it  becomes  clear  that  some  do  not  make  any  assumptions  about  the  structure  of  the 
objects  they  manipulate.  In  other  words,  the  algorithm  can  be  generalized  to  objects 
of  infinitely  many  different  types.  For  instance,  a  sorting  algorithm  works  for  any  type 
of  value  provided  that  an  ordering  relation  can  be  defined  for  the  values  of  the  type. 
Also,  a  function,  say  length,  that  finds  the  length  of  a  list  object,  is  not  concerned  with 
the  structure  of  the  list  elements.  The  result  is  always  a  natural  number  regardless 
of  the  type  of  the  elements  in  the  list.  So  the  length  function  is  polymorphic  in  the 
sense  that  it  can  work  on  infinitely  many  different  types.  What  we  gain  from  this 
generalizability  property  is  that  the  function  can  have  the  same  source  code,  or  for 
that  matter,  the  same  executable(binary)  for  each  different  type  of  list. 

An  implementation  of  length  in  ML  is  given  by  the  program  below: 

fun  length  []  =  0 

length  (x  ::  xs)  =  1  +  length  xs  ; 

How  can  we  express  this  polymorphic  behaviour  in  the  type  of  length!  Since  the  type 
of  the  list  elements  is  not  relevant  to  the  computation,  we  introduce  a  type  variable 
to  denote  the  type  of  list  elements  and  bind  it  with  a  universal  quantifier.  The  type 
of  length  is  then  written  as 

V7.7  list  — >  int . 

By  instantiating  the  type  variable  7  in  this  type  formula  with  different  types,  we 
can  specialize  the  type  of  the  function  for  different  lists.  For  instance,  following  type 
formulae  show  two  different  specializations,  one  for  integer  list,  and  one  for  real  list: 

int  list  — »  int 

real  list  — >  real 


We  contrast  different  forms  of  polymorphism  in  modern  programming  lan- 
guages below. 

A.  MACRO-BASED  POLYMORPHISM 

Ada  and  C++  implement  the  idea  of  polymorphism  in  the  form  of  Ada  generics 
and  C++  templates.  In  these  languages,  a  type  parameter  for  each  of  the  polymorphic 
type  variables  has  to  be  specified  explicitly.  Before  applying  an  Ada  generic  function 
to  a  value  of  type  r,  one  has  to  create  a  specialized  instance  of  the  function  for  type 
r  explicitly  in  the  source  program.  In  C++,  instantiation  is  done  by  the  compiler 
vice  the  user;  but  the  programmer  has  to  provide  the  actual  type  with  which  the 
parameterized  type  variable  will  be  instantiated. 

The  reason  for  the  earlier  specialization  requirement  is  that,  in  these  languages, 
only  the  same  source  code  is  used  for  a  polymorphic  function.  But  for  each  different 
type  of  argument,  different  executable  code  is  generated.  This  kind  of  polymorphism 
is  syntactic,  since  the  generic  instantiation  is  done  at  compile  time  with  actual-type 
values  that  must  be  available  at  compile  time.  Thus,  a  generic  procedure  can  be 
considered  as  an  abbreviation  for  a  set  of  monomorphic  procedures  with  the  same 
behaviour.  This  is  called  macro-based  polymorphism.  An  alternative  to  macro- 
based  polymorphism  is  parametric  polymorphism,  as  used  in  Standard  ML.  The  key 
difference  is  that  polymorphic  functions  have  an  evaluation  semantics.  Moreover, 
the  same  executable  code  in  addition  to  the  same  source  code  can  be  used  for  a 
polymorphic  function. 

B.  ML-STYLE  POLYMORPHISM 

ML  does  not  require  programs  to  be  annotated  with  types  by  the  program- 
mer; instead,  the  type  of  a  program  is  inferred  by  the  compiler  without  sacrificing 
the  polymorphism.  ML-style  polymorphism  will  be  discussed  in  the  context  of  the 
Hindley/Milner  system  since  the  ML  type  system  is  based  on  it. 


C.      TYPE  SYSTEMS  AND  TYPE  SECURITY 

Although  we  earlier  assigned  types  to  the  function  length,  we  did  not  explain 
how  these  types  can  be  found  in  a  systematic  way  since  it  is  not  always  the  case  that 
programmers  construct  type-correct  programs.  In  general,  we  prefer  languages  that 
verify  the  type  correctness  of  programs  statically,  by  checking  the  type  correctness  of 
every  term  of  a  program  rigorously  (strong  typing).  The  main  aim  of  strong  typing 
is  to  ensure  that  the  values  are  treated  appropriately  according  to  their  structures, 
so  that  the  evaluation  of  a  program  does  not  abort  because  of  type  errors.  If  1  +  true 
does  not  make  sense  with  respect  to  the  semantics  of  a  language  then  one  expects 
the  compiler  find  this  error  before  the  evaluation  of  the  program.  For  instance,  if  + 
denotes  the  addition  of  two  integer  values,  then  at  compile  time  it  should  be  ensured 
that  in  an  application  of  +,  the  parameters  are  terms  of  integer  type.  So  we  need 
some  system  of  rules  which  tells  us  how  to  give  a  type  to  each  kind  of  term  in  the 
language. 

Such  a  rule  system  is  known  as  a  type  system  for  the  language.  Most  of  the 
type  systems  are  written  as  natural  deduction  systems.  Below  is  a  typical  typing  rule 
for  function  application: 

A  h  ei  :  Ti  — >  r2,  A  h  e2  :  Ti 


A  h  e1  e2  :  r2 


In  this  rule 


A  h  ei  :  Tx  — >  r2 

is  called  a  type  judgement  and  we  say  that  e\  has  the  type  T\  —>  r2  with  respect  to 
the  assumption  set  A.  Type  information  for  the  free  identifiers  of  e\  is  taken  from 
the  assumption  set  A1.  If  there  is  no  type  assumption  for  a  free  identifier  in  the 
assumption  set  then  we  say  e\  is  not  well-typed  or  is  ill-typed.  We  say  that  a  term  e 


1When  the  language  is  extended  with  imperative  features,  A  has  to  be  extended  with  the  as- 
sumptions about  the  type  of  memory  addresses.  This  issue  will  come  up  in  Chapter  II. 


is  well-typed  with  respect  to  A  if  there  is  a  type  r  such  that  A  h  e  :  r.  An  assumption 
set  is  also  called  a  type  environment. 

In  an  explicitly-typed  programming  language,  where  the  programs  are  anno- 
tated with  type  information,  type  checking  ensures  that  type  annotations  are  consis- 
tent with  the  type  system.  On  the  other  hand,  the  types  of  programs  including  the 
parameterization  of  types  can  be  inferred  statically  by  the  compiler  without  requiring 
any  type  annotations  in  the  source  code.  This  idea  is  one  of  the  reasons  for  the  huge 
success  of  ML,  which  does  type  inference  instead. 

We  want  programs  to  run  without  run-time  type  errors.  For  this  reason  we 
develop  two  orthogonal  systems  of  rules,  namely  a  type  system  and  a  semantics.  If  the 
type  system  types  a  program  correctly  then  the  evaluation  of  this  well-typed  program 
does  not  get  stuck  due  a  type  error.  The  security  from  run-time  type  errors  is  known  as 
the  soundness  of  a  type  system.  The  type-soundness  proof  of  a  purely  functional  type 
system  is  typically  more  straightforward  than  that  of  an  imperative  type  system  with 
first-class  references(pointers),  first-class  functions,  and  polymorphism.  Coexistence 
of  first-class  references  and  polymorphism  is  the  main  source  of  difficulty,  and  it 
requires  a  precise  formulation  of  the  polymorphic  treatment  of  references  as  well  as 
a  careful  formulation  of  the  semantics  of  a  language.  Dam  as 's  faulty  proof  of  a  type- 
soundness  theorem  [Dam85]  is  an  illustration  of  this  difficulty  [Tof90]. 

1.        Hindley/Milner  Type  System 

Hindley's  type  discipline  [Hin69]  introduces  type  variables  in  type  expressions 
without  any  quantification.  Later,  Milner  introduced  quantification  of  type  variables 
[Mil78].  Damas  and  Milner  gave  an  application  of  these  ideas  in  a  purely  functional 
setting  [DaM82].  The  Hindley/Milner  type  system  has  three  important  properties: 
parametric  polymorphism,  type  inference  and  soundness  and  completeness  of  type  in- 
ference. 


a.  Parametric  Polymorphism 

The  polymorphism  used  in  Hindley/Milner  system  is  also  called  let 
polymorphism,  because  polymorphic  functions  are  allowed  only  in  the  local  scope  of 
a  let  construct  together  with  a  notion  of  instantiation.  In 

let  x  =  e-i  in  e^  , 

if  ei  has  the  type  r  with  respect  to  A  then  x  is  assumed  to  have  type  a,  which  is 
found  by  quantifying  the  type  variables  that  occur  in  r  but  do  not  occur  free  in  the 
assumption  set  A.  Then  x  binds  all  free  occurrences  of  x  in  e2,  each  of  which  has  as 
its  type  an  instance  of  a. 

The  Hindley/Milner  system  imposes  a  restriction  on  the  quantification: 
all  type  formulae  have  to  be  in  prenex  normal  form]  in  other  words,  quantification 
must  be  done  at  the  outermost  level.  A  type  formula  in  prenex  normal  form  is  also 
called  a  shallow  type. 

It  should  be  noted  that  let  x  =  e\  in  ti  can  be  thought  of  as  an  abbre- 
viation for  {\x.e<i)e\  as  far  as  the  evaluation  of  these  two  constructs  are  concerned. 
But  there  is  a  difference  between  them  when  it  comes  to  how  they  are  treated  by  the 
type  system.  In  let  x  =  e\  in  e2 ,  e\  can  be  typed  polymorphically,  but  in  (Ax.e2)ei, 
e\  has  to  be  monomorphic,  since  otherwise  the  type  formula  computed  for  it  would 
not  be  in  prenex  normal  form!  Assume  we  give  e\  the  type  a,  which  is  universally 
quantified  over  some  type  variables,  and  e2  the  type  r.  Then  \x.e2  has  to  be  given 
the  type  a  — »  r,  which  is  clearly  not  in  prenex  normal  form. 

b.  Type  Inference 

There  is  an  efficient  algorithm,  called  W  [DaM82],  for  the  type  sys- 
tem. W  determines  whether  a  given  program  is  well-typed  and  infers  the  most  gen- 
eral (principal)  type  for  it. 

Starting  from  the  leaves  of  the  parse  tree  of  a  program  with  an  empty 


assumption  set2  ,  W  implicitly  annotates  the  program  with  type  information  and, 
at  the  end,  either  finds  the  principal  type  of  the  program,  if  the  program  is  well- 
typed,  or  fails.  Roughly  speaking,  a  principal  type  is  one  from  which  all  other  types 
of  the  program  can  be  derived.  In  the  next  chapter  we  will  show,  in  detail,  how  an 
extension  of  W  infers  types  for  well-typed  programs  in  Polymorphic  C.  Restricting 
the  type  formulae  to  prenex  normal  form  allows  the  use  of  Robinson's  first  order 
unification  algorithm  [Rob65]. 

c.  Soundness  and  Completeness 

In  [DaM82]  it  is  shown  that  W  is  sound,  in  the  sense  that  it  finds  types 
only  for  well-typed  expressions,  and  complete,  in  the  sense  that  if  a  program  is  a 
well-typed  then  W  finds  the  most  general  type  for  it. 


2Actually,  a  type  assignment  process  never  starts  with  an  empty  assumption  set  if  there  are 
built-in  operations  in  the  language  but  we  would  like  to  consider  the  emptiness  of  the  assumption 
set  in  terms  of  adding  a  new  assumption  to  the  set  during  the  process  of  type  assignment. 


II.         THE  POLYMORPHIC  C  LANGUAGE 

This  section  gives  an  overview  of  Polymorphic  C.  Hereafter  we  use  PolyC 
instead  of  Polymorphic  C  as  a  shorthand.  The  reader  should  see  [SmV96a]  for  a 
detailed  account  of  PolyC. 

PolyC  is  designed  to  incorporate  an  advanced  polymorphic  type  system,  si- 
miliar  to  those  designed  as  extensions  to  the  core-ML  type  system,  into  the  widely 
used  imperative  programming  language,  C.  Unlike  other  extensions,  the  PolyC  type 
system  also  captures  polymorphic  typing  of  first  class  pointers. 

PolyC  is  semantically  very  close  to  K&;R  C  [KR78],  with  the  same  pointer 
operations,  including  the  address  of  &,  the  dereferencing  *,  and  pointer  arithmetic. 
The  main  design  rationale  was  to  bring  ML-style  polymorphism  and  type  security  to 
C  while  keeping  the  flexibility  and  simplicity  of  C.  Variables  in  PolyC  are  second  class 
and  implicitly  derefenced,  while  pointers  are  first  class  and  explicitly  dereferenced  by 
the  *  operator. 

As  a  new  feature,  functions  are  first  class  citizens  in  PolyC,  and,  as  in  C, 
function  applications  are  implemented  on  a  stack  without  use  of  static  links  or  displays 
by  imposing  a  restriction  on  functions:  The  free  identifiers  of  a  function  must  be 
declared  at  top  level;  that  is,  the  scope  of  the  declaration  must  extend  all  the  way  to 
the  end  of  the  program [SmVo95].  In  C,  no  automatic  variable1  can  occur  free  in  a 
function  declaration  so  that  a  function  declaration  is  closed  with  respect  to  the  top- 
level  (global)  identifier  set.  PolyC  establishes  the  same  property  via  this  restriction 
by  ensuring  that  a  lambda-bound  identifier,  or  an  identifer  bound  by  a  let,  letvar  or 
letarr  declaration  whose  scope  does  not  extend  to  the  end  of  the  program,  does  not 
occur  free  in  a  function.  In  the  program  below,  the  scope  of  y  does  not  extend  to  the 


1 A  variable  that  is  created  as  a  result  of  a  function  application.  In  other  words,  the  local  variables 
of  a  function  including  its  formal  parameters. 


end  of  the  program,  so  Xz.z+y  is  not  closed  with  respect  to  top-level  identifiers. 

letvar  x  :—  letvar  y  :=  5  in  Xz.z  +  y 
in  . . . 

But  this  restriction  has  another  consequence:  Currying  of  functions  is  not  al- 
lowed anymore.  An  attribute  grammar  enforcing  the  restriction  is  given  in  Appendix. 

PolyC  does  not  distinguish  between  commands  and  expressions .  Every  term 
of  the  language  is  an  expression.  A  subset  of  expressions,  however,  are  distinguished 
as  Values,  which  are  the  syntactic  values2  of  the  language.  The  core  syntax  is  given 
below. 

(Expr)       e   ::=      v   |   e(e1,...,en)   \   e1  :=  e2    | 

he   |   *e   |   ei  -f  e2   |   ci[c2]    |   ci;  e2   | 

while  ex  do  e2 

if  ei  then  e2  else  e3    | 

let  x  =  t\  in  e2 

letvar  x  :—  ex  in  e2 

letarr  x[ei]  in  e2 

(a,l) 

(Values)  v  ::=  x  \  c  \  Xxi,...,xn.e  |  (a,0) 
Meta-variable  x  ranges  over  identifiers,  c  over  literals  (such  as  integer  literals  and 
unit),  and  a  over  addresses.  To  be  able  to  catch  pointer  errors  in  the  semantics,  an 
address  is  designed  as  a  pair  (i,j),  where  i  is  a  segment  and  j  is  an  offset  in  that 
segment.  The  lifetime  of  a  cell  ends  when  the  scope  of  the  identifier  to  which  it  is 
bound  ends. 

Since  core  PolyC  does  not  support  overloading,  +  denotes  only  pointer  arith- 
methic  and  *  denotes  dereferencing.    The  construct  letvar  binds  x  to  a  new  cell 


2Syntactic  values  correspond  to  non-expansive  expressions  of  [Tofte90],  where  evaluation  of  a 
non-expansive  expression  does  not  extend  the  domain  of  the  store  function. 


initialized  to  value  of  e\\  the  scope  of  binding  is  e2  and  the  lifetime  of  the  cell  ends 
after  the  evalution  of  e2.  If  t\  has  type  r  then  x  has  type  r  var.  Analogously,  the 
construct  letarr  binds  x  to  a  pointer  to  the  first  cell  of  n  consecutive  uninitialized 
cells  where  n  is  a  positive  integer  found  by  the  evaluation  of  e\\  the  scope  of  x  is  e2, 
and  the  lifetime  of  the  array  ends  after  e2  is  evaluated. 

Having  functions  as  first  class  citizens  leads  to  a  more  flexible  syntax  than  that 
of  C.  In  addition  to  named  functions,  users  can  define  anonymous  functions  easily 
anywhere  in  the  program  such  as 

let  id  —  Xx.x  in  id(Xy.y  +  1). 

PolyC  does  not  have  an  explicit  syntax  to  create  uninitialized  identifiers  of 
pointer  type.  But  it  unifies  array  types  and  pointers,  as  in  C.  Then  declaring  an 
array  of  size  1  is  the  declaration  of  an  uninitialized  pointer  type  identifier. 

Another  subtle  syntactic  difference  is  in  the  treatment  of  the  formal  parameters 
of  a  function.  In  C,  formal  parameters  are  considered  as  local  variables  of  a  function, 
whereas  they  are  treated  as  constants  in  PolyC.  But  it  is  not  hard  to  achieve  a  C-like 
treatment  by  declaring  new  local  variables  in  the  body  of  the  function  and  initializing 
them  to  the  values  of  the  formal  parameters.  Below,  a  C  function  and  its  PolyC 
version  are  given  in  order. 

int  f(int  x){. . .  return  x\  } 

let  /  =  Arr.letvar  x  :=  x  in  x  in  . . . 

A.      THE  TYPE  SYSTEM 

ML  stratifies  the  types  into  two  levels:  the  ordinary  r  —  types  (data  types) 
and  a  —  types  (type  schemes).  PolyC  adds  another  level  to  this  stratification,  namely 
p  —  types  (phrase  types)  to  establish  the  second-class  status  of  variables.  Types  of 
PolyC  are  given  below  [SmV96a]  : 


T\\—      a    \    int       unit    |    r  ptr   \   T\  x  •  •  •  x  rn  — >  r  (data  types) 

a   ::=     Va.cr    |    r  (type  schemes) 

p   ::=      a    \    r  var  (phrase  types) 

Meta  variable  a  ranges  over  type  variables. 

The  type  system  is  designed  as  a  natural  deduction  system  to  assign  types  to 
expressions.  It  is  given  in  Figure  1  [SmV96a]. 

In  Section  B,  we  saw  that  the  type  of  a  term  is  found  with  respect  to  an 
assumption  set  A,  where  A  ranges  over  identifiers  and  assigns  types  to  free  identifiers 
of  a  term.  Having  A  range  over  identifiers  only  is  adequate  for  sound  typing  in  a 
functional  setting,  but  if  the  language  includes  assignable  locations,  then  we  have  to 
be  able  to  implicitly  type  a  location,  regarding  the  value  stored  in  it,  to  get  a  handle 
on  the  soundness  of  the  type  system.  Intuitively,  a  location  must  be  given  a  monotype 
since  we  can  not  store  different  types  of  values  in  a  location.  A  thorough  discussion 
of  the  difficulties  with  references  in  a  polymorphic  type  system  is  given  in  [Tof90].  As 
given  in  Figure  1,  typing  judgements  have  the  form 

A;  7  h  e  :  p, 

meaning  that  expression  e  has  type  />,  assuming  that  7  prescribes  phrase  types  for 
the  free  identifiers  of  e  and  A  prescribes  data  types  for  the  variables  and  pointers 
in  e.  More  precisely,  meta-variable  7  ranges  over  identifier  typings,  which  are  finite 
functions  mapping  identifiers  to  phrase  types;  7(2)  is  the  phrase  type  assigned  to  x 
by  7  and  j[x  :  p]  is  a  modified  identifier  typing  that  assigns  phrase  type  p  to  x  and 
assigns  phrase  type  7(2')  to  any  identifier  x'  other  than  x.  Similiar  conventions  apply 
to  \(x)  and  X[x  :  p]  [SmV96a]. 

Generalization  of  data  type  r  with  respect  to  A  and  7  is  denoted  by  Close  \.^(t) 
and  is  equivalent  to  the  type  scheme  VcL  r,  where  a  is  the  set  of  all  type  variables 
occurring  free  in  r  but  not  in  A  or  in  7.  We  write  A  h  e  :  r  and  Close\(r)  when  7  =  0. 
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Var-id) 

[ident) 

'ptr) 

Var) 

[lit) 

»-INTRO) 

*-elim) 

[let-val) 
'let-ord) 
^letvar) 
[letarr) 

;r-val) 

[l-val) 
{  address) 
[  assign) 


A;  7  h  x  :  r  var  li.x)  —  T  var 

A;  7  h  a:  :  t  tC31)  ^  r 

A;  7  I"  ((i,i),0)  :  r  ptr  \(i)  =  r 

A;7  ^  ((*>i)»l)  :  T  ™*r  A(i)  =  r 

A;  7  h  c  :  mi  c  is  an  integer  literal 

A;  7  h  unit  :  unit 

A;  7[a?i  :  tj,  . . .  ,xn  :  rw]  h  e  :  r 

A;  7  h  Aii,. .  .,xn.  e  :  ri  X  ••■  X  rn  — >  r 

A;  7  h  e  :  Tx  x  •  •  •  x  rn  — >  r, 
A;  7  h  e;  :  r2-,    1  <  z  <  n 


A; 7  h  e(ei,...,en)  :  r 

A; 7  h  v  :  ri,    A;  7(2  :  Close A;7(n)]  t~  e  :  r2 


A; 
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hlet 
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=  ei 

in  e2  :  r2 

A; 
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A;7[:r 

:  Tj  ptr]  l~ 
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:  ^2 

A;  7  h  letarr  x[ei]  in  e2  :  r2 

A;7H 


e  :  r  uar 


A; 
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e  : 

r 

A; 

7 

h 

e  : 

r  pir 

A; 

7 

h 

*e 

:  r  uar 

A; 

7 

h 

e  : 

r  far 

A;  7  h  &e  :  r  ptr 

A;  7  h  ei  :  r  var,    A;  7  h  e2  :  r 
A;  7  h  e1  :=  e2  :  r 


Figure  1.  Rules  of  the  Type  System,  continued  next  page 
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(ARITH)  A;  7  h  d  :  r  ptr,    A;  7  h  e2  :  in* 


A;  7  h  t\  +  e2  :  t  ptr 
(SUBSCRIPT)  A;  7  h  ex  :  r  ptr,    A;  7  h  e2  :  in* 


A;  7  h  ei[e2]  :  r  var 
(WHILE)  \;j\-  ex  :  int,    X;j\-e2:T 


A;  7  h  while  ex  do  e2  :  wrni 

(COMPOSE)  A;7  h  ei  :  tx   A;  7  h  e2  :  r2 

A; 7  h  ei;e2  :  r2 

Figure  2.  Rules  of  the  Type  System,  cont. 

Typing  a  let  construct  is  done  via  two  rules,  namely  LET-VAL  and  LET-ORD. 
If  ei  is  a  syntactic  value  then  LET-VAL  is  used  and  x  is  given  a  phrase  type  by 
genaralizing  the  type  of  ei.  On  the  other  hand,  LET-ORD  is  defined  for  the  cases 
where  ei  is  not  a  syntactic  value  and  no  type  generalization  is  allowed.  Regarding 
these  two  rules,  all  of  the  type  variables  in  PolyC  can  be  seen  as  imperative(weak) 
when  compared  to  Standard  ML  type  system  [Tof90]. 

1.       Examples  of  Type  Inference 

Consider  the  program 

let  id  =  Xx.x   in  id(\y.y  +  1) ;  id(3)  . 

We  start  with  empty  domains  for  A  and  7.  The  LET-VAL  typing  rule  is  the  first  one 
to  start  with  since  Xx.x  is  a  value.  By  the  first  premise  of  LET-VAL,  Xx.x  is  given 
the  type  a  — >  a.  We  extend  7  with  x  :  Va.a  — >  a  by  closing  a  — >  a  with  respect 
to  A  and  7,  and  try  to  type  the  sequence  id(Xy.y  +  l);id(3).  The  first  expression  of 
the  sequence  is  typed  using  — »-ELIM.  We  instantiate  id  as  j3  — >•  0  and  Xy.y  +  1  is 
given  the  type  (  ptr  — *  £  ptr.  Rule  — ^--ELIM  requires  j3  and  £  ptr  be  the  same,  so  we 
unify  them  with  representative  type  £  ptr.  The  second  expression  is  also  typed  by 
— >-ELIM.   We  instantiate  id  to  £  — >  £  this  time,  and  3  has  type  int.   By  — »-ELIM,  £ 


12 


and  int  are  unified  to  int.  So  the  result  of  the  application  has  type  int.  Then  by 
COMPOSE,  id(\y.y  +  1);  id(3)  is  given  the  type  int.  Since,  the  hypotheses  of  LET-VAL 
are  satisfied,  it  is  deduced  that  the  program  has  the  type  int. 

The  program  below  shows  how  the  type  system  prevents  memory  locations 
from  being  treated  polymorphically. 

letvar  id  :=  Xx.x  in  id  :=  Xy.y  +  1  ;  let  id'  =  id  in  id' (3) 

We  start  with  the  LETVAR  typing  rule  and  give  the  type  a  — >  a  to  Xx.x.  Then  we 
extend  7  with  id  :  (a  — ►  a)  var  and  try  to  type  the  body  of  letvar,  which  is  a  sequence. 
The  first  expression  of  the  sequence  is  typed  using  ASSIGN.  The  type  (a  — >  a)  var  is 
given  to  id  by  7,  and  Xy.y  +  1  is  given  the  type  (3  ptr  — >  ft  ptr  .  By  ASSIGN,  a  —>  a 
and  (3  ptr  — >  (3  ptr  must  be  the  same.  So  we  unify  a  and  /3  ptr  with  representative 
type  (3  ptr.  Finally,  the  assignment  is  given  the  type  (3  ptr  — *  (3  ptr  and  7  gives  the 
type  {(3  ptr  — >  j3  ptr)  var  to  id  from  now  on. 

The  second  expression  of  the  sequence  is  a  let  expression.  Since  id  is  an 
identifier  we  use  the  LET-VAL  typing  rule.  The  type  (/?  ptr  — >  f3  ptr)  var  is  given 
to  id  by  7.  Since  id  is  in  an  r- value  context,  we  use  rule  R-VAL  and  find  the  type 
(3  ptr  — ►  (3  ptr  for  id.  Then  we  extend  7  with  id'  :  Close yn(/3  ptr  — *  f3  ptr).  (3  occurs 
free  in  7  by  the  fact  that  it  occurs  free  in  the  type  judgement  id  :  (/3  ptr  — >  0  ptr)  var 
,  so  Close\.n((3  ptr  — >  j3  ptr)  =  0  ptr  —+  0  ptr.  Now,  we  try  to  type  the  body  of  the 
let  expression  which  is  the  application  id' (3).  The  type  (3  ptr  — »  (3  ptr  is  given  to 
id'  by  7  and  3  has  the  type  int.  But  then  — >--ELIM  requires  (3  ptr  and  int  be  the 
same  which  is  not  possible.  So  we  conclude  that  this  application  is  not  typable  and 
therefore  the  program  is  untypable. 

Having  first  class  pointers  in  the  language  can  lead  to  the  occurrence  of  dan- 
gling pointers.  To  preserve  the  flexibility  and  expressiveness  of  C,  PolyC  does  not 
prevent  the  dangling  pointers  but  the  semantics  catches  the  dereferencing  of  a  dan- 
gling pointer.  The  program  below  shows  how  a  reference  location  escapes  from  its 
scope  by  returning  the  address  of  the  variable  y  in  the  body  of  the  inner  letvar 

13 


expression,  and  how  the  type  system  assigns  a  type  to  this  program. 

letvar  x  :=  letvar  y  :—  Xz.z  in  Szy  in  (*x)(3) 

We  start  with  the  LETVAR  typing  rule  to  type  the  program.  The  first  premise  of 
LETVAR  requires  us  to  type  the  inner  letvar  expression,  letvar  y  :=  Xz.z  in  hy  .  By 
a  second  use  of  LETVAR,  we  give  the  type  a  — »  a  to  Xz.z,  and  then  by  extending  7 
with  y  :  (a  — »  a)  var,  the  body  of  inner  letvar,  $zy,  is  given  the  type  (a  — >  a)  ptr. 
So  it  is  deduced  that  the  inner  letvar  has  the  type  (a  — >  a)  ptr  .  Now  7  is  extended 
with  x  :  ((a  — >  a)  ptr)  var,  and  we  try  to  type  the  body  of  the  outer  letvar.  Since 
it  is  an  application,  we  use  — >-ELIM.  We  type  *x  by  first  using  R-VAL,  then  L-VAL 
followed  by  R-VAL  again  giving  type  a  — *  a.  Since  3  has  the  type  int,  we  deduce  the 
type  int  for  the  application  and  also  for  the  program  itself. 

In  Chapter  III  we  will  show  how  the  semantics  prevents  the  evaluation  of  this 
program  by  catching  the  dereferencing  of  the  dangling  pointer  stored  in  x. 
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III.         THE  TYPE-INFERENCE  ALGORITHM 

In  this  chapter  we  present  the  type-inference  algorithm  Wc.  It  is  similiar  to 
Milner's  algorithm  W  [DaM82],  which  is  based  on  unification  of  type  expressions.  We 
also  present  an  example  type  inference  produced  by  the  computer  implementation  of 
Wc.  We  first  give  some  definitions  about  substitution  and  unification. 

A.      SUBSTITUTION  AND  UNIFICATION 

A  substitution  5  is  a  finite  set  of  the  form 

[Ti/ai,T2/at2,.  .  .,rn/an] 

where  the  variables  a,-  (1  <  i  <  n)  are  distinct.  Sp  is  called  the  application  of 
substitution  S  to  type  expression  p.  The  result  of  Sp  is  another  type  expression  //, 
obtained  from  p  by  replacing  simultaneously  each  free  occurrence  of  the  variable  az, 
1  <  i  <  n  in  p  by  t,-  ,  renaming  the  bound  variables  of  p  if  necessary,  p'  is  called  an 
instance  of  p.  Note  that  p  and  p'  can  be  the  same  if  no  a,-  occurs  in  r. 

We  often  write  ^(Si/?)  or  simply  S2S1P  for  the  application  of  the  composition 
5*1  o  52  to  p.  An  empty  substitution  is  written  as  []. 

A  substitution  S  is  called  a  unifier  for  type  expressions  p\  and  P2  if  Sp\  —  S p2- 
We  say  p\  and  P2  are  unifiable  if  there  is  a  unifier  for  them. 

A  unifier  S  is  called  the  most  general  unifier  of  pi  and  P2  if  for  every  other 
unifier  S'  of  pi  and  /)2  there  is  a  substitution  S"  such  that 

S'  =  S  o  S". 

Unification  of  type  expressions  is  implemented  using  Robinson's  first  order 
unification  algorithm,  which  returns  a  substitution  U,  where  U  is  the  most  general 
unifier  of  a  pair  of  type  expressions  p\  and  p2  given  as  the  arguments  to  the  algorithm 
[Rob65];  if  p\  and  P2  are  not  unifiable  then  the  algorithm  fails  to  return  such  a 
substitution. 
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B.      ALGORITHM  Wc 

Wc  takes  two  input  arguments,  7  and  e,  and  returns  a  pair  (£,  r).  As  defined  for 
the  type  system,  7  is  a  finite  function  mapping  identifiers  to  phrase  types.  The  second 
input  argument  e  is  the  expression  whose  type  is  to  be  inferred,  S  is  a  substitution 
and  r  is  the  type  inferred  for  e  by  Wc.  The  type  returned  by  Wc  is  a  r  —  type  in  that 
it  is  called  only  in  r- value  contexts.  Since  locations  do  not  occur  in  user  programs, 
we  do  not  use  a  location  typing  A  in  Wc.  Only  7  is  needed  to  do  type  inference. 

W(7,  e)  is  defined  by  cases: 

1.  e  is  x 

case  7(2)  =  Vai, . . . ,  an.r 

return  ([  ],  [^/a,]r)  where  /?;  is  new  for  each  1  <  i  <  n 
case  7(2)  =  t 

return  ([  ],r) 
case  7(2)  =  t  uar 

return  ([  ],t). 

2.  e  is  Azi, . . . ,  xn.e\ 

let  (Si,  Ti)  =  W(i[x\  :  ^1, . . .  ,xn  :  /3n],  ei)  where  /9t's  are  new 
return  (£i,Si(/?i  X  •••  X   ^n)  -»  n). 

3.  e  is  e'(ei, . . . ,  en)  then 

let  (5',r')  =  W(rf,e') 
let(51,r1)  =  T7(5'7,eO 


let  (5n,  rn)  =  iy(5n_i5n_2  •  •  •  SiS'7,  en) 

let  5"  =  Unify(C0Tf,  (dn  x  C2r2  x  •  •  •  x  Cn_irn_2  x  5nrn_i  x  rn)  -^  /8) 
where  /?  is  new, 
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Cx  =  SnSn-i  ■  ■  ■  Si+i  and  1  <  i  <  n 
return  (SnSn-i  •••  SiS',  S"j3). 

4.  e  is  let  x  =  e\  in  e2 

let(51,r1)=W(7,e1) 

if  e\  is  a  syntactic  value  then 

let  (S2,r2)  =  W(Si7f[x  :  C/ose5l-Y(r1)],  e2) 

else 
let(52,r2)  =  W(517[x:r1],e2) 

return  (525i,r2). 

5.  e  is  letvar  x  :  =  t\  in  e2 

let  (5lf r1)  =  W{>y,e1) 

let  (52,t2)  =  W(5i7[a:  :  T\  wzr],e2) 
return  (525i,  r2). 

6.  e  is  letarr  x[ei]  in  e2  then 

let(51,r1)  =  ^(7,e1) 

let  S'  =  Unify  (tx,  ini) 

let  {S21T2)  =  W{S'S\^[x  :  f3ptr],e2)  where  0  is  new 

return  (525'5i,r2). 

7.  e  is  *ei  then 

let(5i,Ti)  =  W(7,e1) 

let  5'=  Unify {tu /3  ptr) 

where  /?  is  new 
return  {S'SuS'p). 
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8.  e  is  hex  then 

case  ei  is  x 

if  7(2;)  =  Tivar  then 
return  ([  ],Tx  _p£r) 

else  fail 
case  ei  is  *e2 

let(5,1,r1)  =  W(7,ea) 

let  S'  =  Unify (ti,  /3  ptr)  where  j3  is  new 

return  (S'SU  S'fiptr). 

9.  e  is  t\  :=  e2  then 

case  t\  is  x 
if  7(x)  =  r  uar  then 

let(5i,T1)  =  W(7,c3) 

let  S'  =  Unify (ti,  Sit) 

return  (S'Si,  S'ti). 
else  fail 
case  t\  is  *e' 
let(51,r1)  =  ^(7,e') 
let  5"  =  Unify (ti  ,  fl  ptr)  where  /?  is  new 
let(52,r2)  =  ^(5'5l7,e2) 
let  5"=  Unify{r2,S2S'/3) 
return  (S"S2S,S1,  S"r2) 

10.  e  is  ei  +  e2  then 

let(5i,Ti)  =  W(7,ei) 

let  S'  =  Unify (ji ,  0  ptr)  where  j3  is  new 
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\et(S2,T2)  =  W(S'S1y,e2) 

let  S"  =  Unify (t2,  int) 

return  (S"S2S'SU  S"S2S'/3ptr) 

11.  e  is  ei;  e2  then 

let(5i,ri)  =  W(7,ei) 
let  (S2,T2)  =  W(Sn,e2) 

return  (S2Si,t2) 

12.  e  is  while  e\  do  e2  then 

let(51,r1)  =  ^(7,e1) 

let  5"  =  Unify {t-l,  int) 
\et(S2,T2)  =  W(S'Sly,e2) 
return  (S2S'Si,unit) 

Function  Unify  is  the  implementation  of  Robinson's  unification  algorithm  and 
Closes^iri)  in  case  4  is  the  generalization  of  T\  with  respect  to  the  environment 
found  after  the  application  of  the  substitution  S\  to  7. 

d  in  case  3  denotes  the  composition  of  substitutions  that  is  applied  to  the 
type  of  the  ith  actual  parameter  of  a  function  application,  where  1  <  i  <  n  and  n  is 
the  number  of  formal  parameters.  Co  is  the  substitution  composition  applied  to  the 
called  function. 

We  omit  the  default  arm  of  case  statements  for  simplicity  and  it  corresponds 
to  a  fail  case  of  Wc.  In  addition  to  the  explicitly  stated  fail  cases,  Wc  also  fails  if 
Unify  fails  to  return  a  substitution  or  any  subinvocation  of  Wc  fails. 

Array  subscripting  t\[e2]  is  a  syntactic  sugar  for  *(ei  +  e2)  so  that  we  do  not 
consider  array  subscripting  as  a  separate  case  in  Wc. 
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The  algorithm  does  not  explicitly  specify  how  a  "new" type  variable  is  obtained. 
We  assume  that  there  is  a  global  list  of  used  variables,  and  that  new  ones  are  selected 
from  those  not  in  that  list. 

1.        Sample  Type  Inference  with  Wc 

An  interpreter  for  PolyC  has  been  written  using  The  Synthesizer  Generator 
environment  [Gram].  It  includes  an  implementation  of  Wc  and  the  syntax  and  the 
natural  semantics  of  PolyC  given  in  [SmV96a]  with  some  modifications.  Source  code 
for  the  interpreter  is  given  in  Appendix. 

Below  is  an  implementation  of  a  HeapSort  algorithm  in  PolyC  [Cor90].  The 
type  annotations  shown  as 

id  :  a 

for  selected  identifiers  only  are  done  automatically  by  the  interpreter. 

let  Swap  :  V  *  9.(*9  ptr  x  *9  ptr  — »  *9)  :=  A(a,  b)  {let  temp  =  \a  in 

!a  :=!&; 
\b  :=!&; 
end  }  in 
letvar  heapSize  :  int  var  :=  0 

let  Heapify  :  V  *  21.(*21ptr  x  int  x  (*21  x  *21  — >  int)  — >  unit) 
=  A(a,  i,  cornp) {letvar  left  :  int  var  :=  2  *  i '  +  1  in 

letvar  current  :  int  var  :=  i  in 
while  left  <  heapSize  —  1  do 
if  left  <  heapSize  —  1 

then  if  comp(a[left],a[left+  1]) 
then  largest  :—  left 
else  largest  :=  left  +  1 
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fi 

else  largest  :=  left 

fi; 

if  comp(a[largest],  a[current])  then 
Swap(ka[largest],  ha[current\); 
current  :  =  largest] 
left  :=  2  *  current  +  1 
else  left  :=  heapSize  +  1 
fi 
od 
end 
end 
end  }  in 
let  BuildHeap  :  V*  29.(*29ptr  x  int  x  (*29  x  *29  -*  int)  — >  unit) 
=  A(a,  size,  cornp) {heap Size  :=  size; 
letvar  i  :=  size/2  —  1  in 
while  i  >  0  do 

Heapify(a,  i,  comp) ; 
i  :=  i  —  1 
od 
end  }  in 
let  HeapSort  :  V*  35.(*35ptr  x  int  x  (*35  x  *35  — >  int)  — »  unit) 
=  A(a,  size,  comp) {BuildHeap [a,  size,  comp); 
letvar  i  :=  size  —  1  in 
while  i  >  1  do 
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Swap(foa[i],  &a[0]); 

heapSize  :=  heapSize  —  1; 
Heapify(a,  0,  comp); 
i  :  =  z  —  1 
od 
end  }  in 
letarr  a[8]  in 
o[0]  :=  12; 
a[0]  :=  5; 
o[0]  :=  23; 
a[0]  :=  8; 
a[0]  :=  1; 
a[0]  :=  45; 
a[0]  :=  17; 
a[0]  :=  51; 

HeapSort(a,  8,  A(a,  6)  {a  >  6}); 
(a[0],  (a[l],  (a[2j,  (a[3],  (a[4],  (a[5j,  (a[6],  a[7]))))))) 
end 
end 
end 
end 
end 
end 

val   (1,(5,(8,(12,(17,(23,(45,51))))))) 
:  (int  x  (int  x  (int  x  (int  x  (int  x  (int  x  (int  x  int))))))) 
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In  type  expressions,  Cartesian  product  x  binds  tighter  than  arrow  —»;  *i,  where  1  G 
Natural,  is  a  type  variable  generated  by  a  global  new  type  variable  generator  function. 
The  second  line  from  the  last  shows  the  result  of  the  evaluation  of  the  program  and  the 
last  line  shows  the  type  of  the  program.  Here  we  use  *  to  denote  integer  multiplication 
vice  dereferencing,  which  is  denoted  by  !,  and  -f  denotes  integer  addition  vice  pointer 
arithmetic,  which  is  denoted  by  0.  Type  quantification  is  denoted  by  V  as  in  the  type 
of  Swap. 

2.        Correctness  Criteria  for  Wc 

Due  to  time  constraints  on  preparation  of  this  thesis,  we  are  not  able  to  pose 
theorems  related  to  correctness  of  Wc  and  prove  them.  Roughly  speaking,  correctness 
of  Wc  should  be  established  by  showing  that  Wc  is  sound  (syntactically)  and  complete. 
By  soundness,  we  mean  that  if  Wc  succeeds  in  finding  a  type  for  a  PolyC  expression 
then  that  type  can  be  derived  for  the  expression  in  the  type  system.  By  completeness, 
we  mean  that  if  an  expression  of  PolyC  has  a  type  at  all  then  Wc  will  succeed  in  finding 
a  type  for  this  expression  which  is  at  least  as  general. 
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IV.         TRANSITION  SEMANTICS  FOR 

POLYC 

In  this  chapter  we  develop  a  transition  semantics  (TS)  for  PolyC  that  cap- 
tures each  single  step  of  the  evaluation  of  an  expression.  First  we  will  look  at  the 
motivations  behind  this  type  of  semantics. 

A.      STRUCTURAL    OPERATIONAL    SEMANTICS    OF 
POLYC 

To  show  the  semantic  soundness  of  the  type  system  of  PolyC,  Smith  and  Vol- 
pano  use  the  framework  of  Harper  [Har94]  and  develop  the  subject  reduction  property 
using  the  Structural  Operational  Semantics(SOS)  given  in  the  same  paper  [SmV96a]. 
But  the  subject  reduction  property  based  on  SOS  does  not  expose  enough  informa- 
tion about  the  course  of  evaluation  of  a  program,  making  it  difficult  to  establish  a 
semantic  soundess  result  for  the  type  system.  SOS  defines  a  relation  between  the 
expressions  and  their  normal  forms  but  does  not  explicitly  keep  track  of  step-by-step 
construction  of  the  evaluation  tree  of  an  expression.  Instead,  by  using  the  composi- 
tionality  property  in  a  coarse-grained  sense,  it  assumes  that  in  one  or  more  steps  the 
evaluation  trees  created  by  the  subexpressions  will  constitute  the  final  evaluation  tree 
of  an  expression.  If  a  subexpression  fails  to  evaluate  to  a  value,  so  does  the  whole 
expression.  But  we  cannot  know  exactly  how  the  subexpression  got  stuck,  which  is 
a  key  issue  in  being  able  to  reason  about  the  semantics  and  its  interaction  with  the 
type  system.  SOS  admits  structural  induction  on  evaluation  derivations. 

Gunter  [Gun92]  strengthens  subject  reduction  for  the  pure  functional  pro- 
gramming language  PCF  by  augmenting  the  evaluation  rules  with  new  rules  that 
evaluate  to  a  special  value,  namely  tyerr  which  does  not  have  a  type.  These  rules 
cover  the  evaluation  of  possible  ill-typed  expressions.  Since  a  well-typed  expression 
never  contains  an  ill-typed  subexpression,  then  any  of  the  rule  instances  that  occur 
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in  the  evaluation  of  a  well-typed  expression  cannot  be  an  instance  of  one  of  these  new 
rules.  Hence,  it  is  not  the  case  that  a  well-typed  expression  evaluates  to  tyerr.  So  by 
showing  that  subject  reduction  holds  for  the  augmented  evaluation  rules,  absence  of 
run-time  type  errors  is  guaranteed.  In  addition  to  the  drawback  of  augmenting  the 
evaluation  rules,  this  approach  does  not  give  us  any  information  about  the  nature 
of  the  other  errors  that  can  occur  during  evaluation  of  well-typed  programs,  which 
will  be  an  important  issue  in  an  imperative  setting  with  assignable  locations  and  first 
class  pointers. 

On  the  other  hand,  Smith  and  Volpano  use  the  combination  of  subject  reduc- 
tion and  a  lemma,  namely  the  Correct  Form  Lemma  to  prove  a  soundness  theorem 
[SmV96a].  The  Correct  Form  Lemma  shows  the  correct  syntactic  form  of  a  value 
when  its  type  is  given.  It  basically  shows  the  type  system  is  not  being  silly  by  giving 
some  unexpected  type  to  a  term.  For  example,  if  a  value  has  type  T\  — *  T2  then  the 
value  is  a  A  —  abstraction  and  not,  say,  an  integer.  Also,  to  get  a  handle  on  the 
"progress"of  an  attempted  evaluation,  the  evaluation  rules  are  re-cast  as  an  instance 
of  a  recursive  function,  eval.  The  Soundness  Theorem  then  shows  that  if  an  activation 
of  eval  aborts,  it  is  due  to  one  of  the  following  four  errors  [SmV96a]: 

El.  An  attempt  to  read  or  write  to  a  dead  address  (i,j)- 

E2.  An  attempt  to  read  or  write  to  a  nonexistent  address  (i,j).  Address  (i,0) 
always  will  exist,  so  the  problem  is  that  the  offset  j  is  invalid. 

E3.  An  attempt  to  read  an  uninitialized  address  (i,j). 

E4-  An  attempt  to  declare  an  array  of  size  less  than  or  equal  to  0. 

But  re-casting  the  evaluation  rules  as  an  instance  of  eval  and  proving  a  sound- 
ness result  based  on  the  abort  conditions  of  eval  seems  a  little  bit  informal.  What  we 
would  like  to  do  is  to  collect  more  information  about  the  "course"  of  the  evaluation  of 
the  programs  so  that  we  can  use  more  formal  techniques  to  prove  a  soundness  result 
for  PolyC.  It  is  for  this  reason  that  we  explore  a  transition  semantics  for  PolyC. 
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B.      TRANSITION  SEMANTICS  FOR  POLYC 

1.  Definitions 

First,  we  give  some  definitions  used  in  the  transition  (evaluation)  rules. 

A  configuration  is  a  triple  (e,  /j,,  S)  where  e  is  an  expression,  6  is  an  active  cell 
indicator,  and  \x  is  a  memory  which  is  a  finite  function  from  addresses  to  values;  ji 
may  also  map  addresses  to  dead  or  uninit,  indicating  that  the  cell  with  that  address 
has  been  deallocated  or  is  uninitialized.  The  contents  of  an  address  a  E  dom(fj,)  is 
the  value  /x(a),  and  we  write  /j,[a  :=  v]  for  the  memory  that  assigns  value  v  to  address 
a,  and  value  fi(a')  to  an  address  a'  ^  a;  fi[a  :=  v]  is  an  update  of  /z  if  a  €  dom(/j,)  and 
an  extension  of  /z  if  a  £  dom(fj,). 

An  active  cell  is  an  address  whose  value  is  not  dead.  The  natural  number  S 
denotes  the  number  of  active  cells  created  so  far  by  an  expression  or  by  its  subex- 
pressions. We  use  6  for  the  purpose  of  keeping  track  of  the  lifetime  of  memory  cells 
that  are  allocated  via  letvar  and  letarr  declarations. 

We  define  a  binary  relation  — *■  from  configurations  to  configurations  to  capture 
the  single  step  transitions.  If  evaluating  the  closed  expression  e  in  memory  [x  with 
respect  to  S  results  in  a  new  expression  e',  a  new  memory  \i'  and  a  new  active  cell 
indicator  £',  then 

(e,  n,  S)  ->  (e',  //,  6') . 

We  write  [e'/x]e  to  denote  the  capture- avoiding  substitution  of  e'  for  all  free 
occurrences  of  x  in  e  and  the  result  of  the  substitution  is  another  expression  of  PolyC. 

2.  The  Transition  Rules 

The  transition  rules  are  given  below: 

(contents) 

(i)  a  £  dom(fi)  and  (i(a)  =  v 


((a,l),fi,S)  -*  {v,fi,S) 
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(deref) 

(i)  a  €  dom(fj,)  and  fi(a)  =  v 


(*(a,0),//,6)  -»  (v,[i,6) 

(II)  (e,;^)->(eV,*') 

(*e,/z,£)  ->  (*e', //,<$') 

(REF) 

(I)  (&(a,l),^)^((a,0),^) 

(II)  (&*(a,O),/*,S)-^((a,0),/*,S) 

(III)  (e,^*)-^',/*',*') 

(&;  *  e,  //,  £)  — »  (&;  *  e',  //,  6') 

(OFFSET) 

(i)  n  an  integer 


(((»,i),0)  +  n,Ai,tf)-»(((t,i  +  n),0),A«,fl 

(II)  (e,^)^(eV,£') 

(((z,j^0)  +  e, ,;,<$) ->(((z,j),0)  +  eV,£') 

(HI)  (d,^)-*  {e',ii',8') 

(ei  +  e2,  /i,  £)  -»  (e'  +  e2,  //,  £') 

(apply) 

(i)  ((A;r1,...,xn.e)(i;i,...,vn),^,<$)  ->  ([vi, . . .  ,vn/xu  . . .  ,3n]e,//,£) 

(II)  (e,/K,*)->(eV,J') 

(e(el5 . . . ,  cn),  /x,  6)  -»  (e'(ei, . . . ,  en),  //,  £') 

(Hi)  (e,-,M)  ->(e;y,6')   1  <i  <n 

((Axi, . . . ,  xn.  e)(ui, . . . ,  Ui_i,  ei5 . . . ,  en),  /x,  6)  -> 

((Aa:i, . . . ,  xn.  e)(ui, . . . ,  u;_i,  cj, . . . ,  e»),^',  <5') 

(UPDATE) 

(i)  a  £  dom(/i)  and  //(a)  7^  dead 


((a,  1)  :=  u,//,£)  ->  (u,/x[a  :=  v],6) 
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(") 
(III) 

(IV) 

(v) 
(bind) 

(I) 

(") 

(bindvar) 

(I) 

(H) 

(III) 

(IV) 

(bindarr) 

(I) 


(e, /*,<*) ->(e', //,£') 


((a,l):=e,^)->((a,l):=eV,<r) 

a  6  dom(n)  and  ^(a)  =£  dead 
(*(a,0)  :=  v,y.,6)  -*  (u,/u[a  :=  v],£) 

(e,^<5)-+(eV,£') 

(*(a,  0)  :=  e,  /»,  *)  ->  (*(a,  0)  :=  e',  //,  <5') 

(ei,/M,^)  -»  (e^/z',6') 

(*ei  :=  e2,fJL,6)  -*  (*e[  :=  e2,  fji',6') 

(let  i  =  i;  in  e, /z,  5)  — *  ([v/x]e,n,8) 
(let  x  =  ei  in  e2,^,£)  — »■  (let  x  =  e[  in  e2, //,£') 

(z,  0)  0  dom(fi) 

(letvar  x  :=  v  in  e,  //,  0)  — > 

(letvar  x  :=  v  in  [((z,  0),  l)/x]e,  fi[(i,  0)  :=  u],  1) 

(z,0)  G  dom(fi)  and  (i,0)  the  last  non-dead  cell 
(letvar  x  :=  uj  in  ^2,/x,  1)  — >  (v2,  At[(i,0)  :=  dead],0) 

(ei,At,S)  ->  (e^, //,£') 

(letvar  x  :=  ei  in  e2,^,£)  — *  (letvar  x  :=  e'x  in  e2, //,£') 

(e,/i,6-l)-»(eV,y)    (£>0) 

(letvar  x  :=  u  in  e,  /i,  <$)  — >■  (letvar  x  :=  v  in  e',  //,  <5'  +  1 ) 


n  a  positive  integer  and  (z,  0)  ^  dom(fi) 
(letarr  x[n)  in  e,/z,0)  — *  (letarr  x[n]  in  [((z,0),0)/x]e, 
/j,[(i,  0), . . . ,  (z,  n  —  1)  :=  uninit, . . . ,  uninit],  1) 


(il)  (z',n  —  1)  E  dom(fj,)  and  (z,n  —  1)  the  last  non-dead  cell 

(letarr  x[n]  in  v,//,  1)  — ► 

(v,  /z[(z,  0), . . . ,  (z,  n  —  1)  :=  dead, . . . ,  dead],  0) 
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(Ill) 

(IV) 


>i,//,£)  ->  (e'l5 //,£') 


(loop) 

(I) 

(branch) 

(I) 

(II) 

(III) 

(compose) 

(I) 
(II) 


(letarr  x[ei]  in  e2,/i,6)  — *  (letarr  xfe'J  in  e2, //,£') 

(e,/z,S-l)->(eV,y)  (6  >  0) 

(letarr  z[n]  in  e,fi,8)  — >  (letarr  x[n]  in  e', //,<$'  +  1) 


(ci,A*,fl  -»  (e'l5 //,£') 


(while  t\  do  e2,/z,£)  -* 

(if  ej  then  e2;  while  ei  do  e2  else  unit,//, 8') 


n  a  nonzero  integer 


(if  n  then  e\  else  e2,^,£)  — »  (ei,fi,8) 
(if  0  then  d  else  e2,  //,  6)  — >  (e2,  fi,  8) 
{ei,f*,6)  -»  (ei, //,£') 


(if  ei  then  e2  else  e3,//,d>)  — •»  (if  ei  then  e2  else  e3,//,  <$^ 


[er.fi,  6)  ->  (e'l5 //,£') 


(ei;e2,^,6)  ->  (ei;  e2,fi',6') 

Meta  variable  v  and  x  range  over  values  and  identifiers,  respectively.  The 
understanding  in  rules  like  DEREF,  REF,  etc.  is  that  if  there  are  transitions  on  e  and 
v  or  at  least  one  specific  syntactic  value  then  e  is  understood  to  be  all  expressions 
except  all  values.  For  instance,  DEREF  has  two  rules;  (i)  defines  a  transition  for  pointer 
type  values  and  (il)  defines  a  transition  for  all  other  expressions  except  values. 

Since  the  lifetime  of  a  memory  cell  is  bounded  by  the  scope  in  which  it  is 
activated,  the  rules  have  to  keep  track  of  the  lifespan  of  each  memory  cell.  In  SOS, 
this  is  easy  to  do,  whereas  the  solution  in  TS  may  seem  unintuitive.  We  introduce 
8  to  keep  track  of  the  scope  information.  Notice  that  in  BINDVAR  (i),  after  a  cell  is 
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allocated  for  a  variable  we  still  keep  the  letvar1  construct  until  the  body  evaluates  to 
a  value.  When  the  cell  is  allocated  8  is  incremented  so  that  we  can  understand  that 
this  letvar  instance  has  actually  allocated  a  cell  and  now  it  is  evaluating  its  body. 
Rules  BINDVAR  (i)  and  BINDVAR  (iv)  show  this  difference.  In  BINDVAR  (i),  the  letvar 
expression  of  the  initial  configuration  has  a  value  v  as  its  t\  and  8  is  0  which  means  a 
cell  has  not  been  allocated  yet.  Then  a  new  cell  for  x  is  allocated  and  initialized  to  v, 
and  8  is  incremented  by  one.  In  BINDVAR  (iv),  the  initial  configuration  is  the  same 
as  the  initial  configuration  of  BINDVAR  (i)  except  that  the  second  premise  forces  8  be 
greater  than  0  which  means  that  this  rule  is  used  only  to  evaluate  the  body  of  letvar. 
Keeping  the  letvar  construct  around  after  we  allocate  a  cell  makes  the  proof  search 
part  of  a  letvar  transition  unnecessarily  long,  but  introducing  a  new  construct  would 
force  us  to  augment  the  type  system  superficially  with  a  new  typing  rule  for  this  new 
construct.  The  evaluation  of  a  program  starts  with  8  =  0  and  ends  again  with  8  =  0. 

At  first  glance,  one  might  be  tempted  to  use  a  variation  of  p- expressions 
to  keep  track  of  the  cells  being  activated  [WrF91].  This  would  not  be  enough  by 
itself,  since  in  PolyC  the  lifetime  of  a  cell  is  bounded  whereas  in  [WrF91]  a  cell  has 
unbounded  lifetime. 

We  assume  that  memory  cells  are  allocated  sequentially  from  a  sufficiently  big 
sequence  of  cells,  where  the  cells  are  associated  with  index  numbers  in  an  increasing 
order.  As  defined  earlier,  an  address  is  a  pair  of  segment  and  offset  numbers  and  it 
indicates  a  cell  in  the  memory.  When  a  variable  v  is  created,  the  cell  with  the  least 
index  number  from  the  non-used  part  of  the  sequence  is  initialized  to  the  value  of 
this  variable,  and  an  address  (i,0)  corresponding  to  this  cell  is  added  to  the  domain 
of  p.  Similiarly,  when  an  array  x  of  size  n  is  created  then  the  first  n  cells  from 
the  non-used  part  of  the  sequence  are  initialized  to  uninit  and  the  corresponding 
addresses  (i,  0),  (i,  1), . . . ,  (z,  n  —  1)  are  added  to  the  domain  of  p.  When  the  scope  of 


1We  will  focus  on  letvar  without  mentioning  letarr  separetely;  in  most  cases  the  same  discussion 
is  also  valid  for  letarr. 
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the  variable  v  or  the  scope  of  the  array  x  ends  then  these  cells  are  marked  as  dead. 
but  they  are  still  kept  in  the  domain  of  fi. 

In  SOS,  a  variable  declaration  and  termination  are  done  within  a  single  eval- 
uation rule  so  that  it  is  easy  to  know  which  address  is  to  be  marked  as  dead.  But  in 
TS,  declaration  of  a  variable  and  termination  of  it  are  done  via  different  rules,  and  the 
address  information  is  not  carried  to  the  next  transition.  Given  the  memory  model, 
it  is  easy  to  find  out  the  memory  cell  to  be  marked  when  necessary.  Simply  search 
through  the  sequence  of  cells  starting  from  the  high-index  numbered  end  of  the  used 
part  of  the  sequence,  and  the  first  cell  that  is  not  marked  as  dead  will  correspond 
to  the  address  of  the  variable  whose  scope  is  ending.  We  call  this  cell  the  last  non- 
dead  cell.  In  case  of  an  array  of  size  n,  the  consecutive  n  cells  starting  from  the  last 
non-dead  cell  are  the  ones  that  will  be  marked  as  dead.  The  reason  that  we  have  to 
search  for  the  last  non-dead  cell  is  because  dead  locations  are  not  taken  away  from 
the  domain  of  pt.  If  an  expression  e  creates  a  variable  x  for  which  the  cell  indexed  i 
is  allocated,  and  if  a  subexpression  of  e  then  creates  another  variable  y,  then  the  cell 
allocated  for  y  has  a  higher  index  j  and  so  j  will  be  marked  as  dead  before  i  since 
the  scope  of  y  ends  before  the  scope  of  x. 

3.       Two  Examples  of  Program  Evaluation 

Figure  3  shows  the  evaluation  derivation  of  the  program 

letvar  x  :=  1  in  letvar  y  :=  x  in  y  . 

The  evaluation  in  Figure  3  is  completed  in  six  transitions.  A  transition  rule 
name  is  given  inside  brackets  to  indicate  the  rule  used  in  making  the  single  transi- 
tion that  follows  it.  For  example,  the  first  transition  is  done  using  the  BINDVAR  (i) 
rule.  The  second,  third,  fourth  and  fifth  transitions  are  done  using  an  instance 
of  BINDVAR  (iv).  In  the  proof  search,  the  second  transition  uses  an  instance  of 
BINDVAR  (ill)  and  CONTENTS,  the  third  transition  uses  an  instance  of  BINDVAR  (i), 
the  fourth  transition  uses  an  instance  of  BINDVAR  (iv),  and  the  fifth  transition  uses 
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BINDVAR  (i)] 

letvar  x  :=  1  in  letvar  y  :—  x  in  y,  [],  0)  — > 

(letvar  x  :=  1  in  [((ix,  0),  l)/x]  letvar  y  :=  x  in  y,  [(ix,  0)  :=  1],  1) 

contents] 

((»,,  0),  1),  [(».,  0)  :=  1],  0)  -►  (1,  [(*«,  0)  :=  1],  0) 

BINDVAR  (ill)] 

letvar  y  :=  ((t«,  0),  1)  in  y,  [(iXJ  0)  :=  1],  0)  -* 

(letvar  y  :=  1  in  y,[{ix,0)  :=  1],0) 

BINDVAR  (IV)] 

letvar  x  :=  1  in  letvar  y  :=  ((zx,  0),  1)  in  y,  [(ix,  0)  :=  1],  1)  — > 

(letvar  a:  :=  1  in  letvar  y  :=  1  in  y,  [(zx,  0)  :=  1],  1) 

BINDVAR  (i)] 

letvar  y  :=  1  in  y,[(ix,0)  :=  1],0)  — > 

(letvar  y  :=  1  in  [(^,0),  l)/y]y,  [(ix,0)  :=  1,(h,0)  :=  1],1) 

BINDVAR  (IV)] 

letvar  x  :=  1  in  letvar  y  :=  1  in  y,  [(zx,  0)  :=  1],  1)  — > 

(letvar  z  :=  1  in  letvar  y  :=  1  in  ((zy,0),  1),  [(ix,  0)  :  =  1,  (zy,0)  :  =  1],2) 

contents] 

((«,,  0),  1),  [(zx,  0)  :=  1,  (s,,  0)  :=  1],  0)  -*  (1,  [(t,,  0)  :=  1,  (iy,  0)  :=  1],  0) 

BINDVAR  (IV)] 

letvar  y  :=  1  in  ((ty,0),l),[(ix,0)  :=  l,(ty,0)  :=  1],1)  -> 

(letvar  y  :=  1  in  1,[(*„0)  :=  1,  (*„,<))  :=1],1) 

BINDVAR  (IV)] 

letvar  a:  :=  1  in  letvar  y  :=  1  in  ((zy,0),  1),  [(ix,0)  :=  1,  (iy,0)  :=  1],2)  -» 

(letvar  x  :=  1  in  letvar  y  :=  1  in  1,  [(ix,  0)  :=  1,  (iy,0)  :=  1],2) 

Figure  3.  Sample  Program  Derivation,  continued  next  page 
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[bindvar  (ii)] 

(letvar?/  :=  1  in  1,  [(ix,  0)  :=  1,  {iy,  0)  :=  1],  1)  -* 

(1,  [(*„0):=  1,(^,0):=  dead],  0) 

[bindvar  (iv)] 

(letvar  :r  :=  1  in  letvar  y  :=  1  in  l,[(i„0)  :=  1,(^,0)  :=  1],2)  -> 

(letvar  a;  :=  1  in  1,[(*.,0)  :=  l,(ivi0)  :=  dead],  1],  1) 

[bindvar  (ii)] 

(letvar  x  :=  1  in  1,  [(ix,  0)  :=  1,  (^,0)  :=  dead],  1)  — * 

(l,[(zx,0)  :=  dead,  (iy,0)  :=dead],0) 

Figure  4.  Sample  Program  Derivation,  cont. 

an  instance  of  BINDVAR  (ii).  The  final  transition  is  done  with  BINDVAR  (il).  So  the 
letvar  expression  evaluates  to  1 . 

Now  let's  turn  back  to  the  well-typed  program 

letvar  x  :—  letvar  y  :=  Xz.z  in  hy  in(*x)(3) 

of  Chapter  I  Section  2,  in  which  the  location  of  y  escaped  from  its  scope  via  the  & 
operator  and  we  inferred  the  type  int  for  this  program.  Figure  5  shows  how  this 
program  gets  stuck  due  to  dereferencing  a  dead  cell. 

The  notation  -ft  denotes  the  stuck  condition  of  a  rule  instance.  In  the  sixth 
transition,  *((^,0),0)  attempts  to  derefence  a  dead  location,  which  causes  the  eva- 
lution  to  get  stuck  because  there  is  no  possible  transition  that  can  be  made.  The 
first  three  transitions  are  done  with  BINDVAR  (ill),  where  in  the  proof  search  the  first 
transition  uses  an  instance  of  BINDVAR  (i),  the  second  transition  uses  the  instances 
of  BINDVAR  (iv)  and  REF,  and  the  third  transition  uses  an  instance  of  BINDVAR  (ii). 
The  fourth  transition  is  done  with  BINDVAR  (i),  because  ((iy,  0),  0)  is  a  pointer,  which 
is  a  syntactic  value  and  8  is  0.  The  fifth  transition  is  done  with  BINDVAR  (ill),  where 
the  instances  of  APPLY  and  CONTENTS  are  used  in  the  proof  search. 
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BINDVAR  (I)] 

letvar  y  :=  Xz.z  in  Szy,  [],  0)  — * 

(letvar  y  :=  Xz.z  in  [((iy,Q),  l)/y]  by,  [(iy,0)  :=  \z.z],l) 

BINDVAR  (III)] 

letvar  x  :=  letvar  y  :=  Xz.z  in  Szy  in  (*x)(3),  [],0)  — > 

(letvar  x  :=  letvar  y  :=  Xz.z  in  &((zy,0),  1)  in(*x)(3),  [(iy,0)  :=  Xz.z],  1) 

ref] 

b((iy,0),l),[(iy:0)  :=  Xz.z],Q)  -+  (((iy,Q),0),[(iy,Q)  :=  Xz.z],0) 

BINDVAR  (IV)] 

letvar  y  :  =  Xz.z  in  &((iy,  0),  1),  [(iy,  0)  :=  Xz.z],  1)  — > 

(letvar  y  :=  Az.jz  in  ((iy,  0),  0),  [(iy,  0)  :=  Xz.z],  1) 

BINDVAR  (ill)] 

letvar  x  :=  letvar  y  :=  Xz.z  in  Sz((iy,  0),  1)  in(*  x)(3),  [(iy,  0)  :=  Xz.z],  1)  — * 

(letvar  x  :=  letvar  y  :=  Xz.z  in  ((iy,0),0)  in(*x)(3),  [{iy,0)  :=  A-z.z],  1) 

BINDVAR  (II)] 

letvar  y  :=  Xz.z  in  ((iy,0),  0),  [(iy,0)  :=  Xz.z],  1)  — * 

(((iy,0),0),[(iy,0):=dead],0) 

BINDVAR  (ill)] 

letvar  x  :=  letvar  y  :=  Az.z  in  ((iy,  0),  0)  in(*  x)(3),  [(iy,  0)  :=  Xz.z],  1)  — > 

letvar  x  :=  {{iy,  0),  0)  in  (*  x)(3),  [{iy,  0)  :=  dead],  0) 

BINDVAR  (i)] 

etvar  x  :=  ((iy,  0),  0)  in  (*  x)(3),  [(iy,  0)  :=  dead],  0)  -+ 
letvar  x  :=  ((iy,  0),  0)  in  [((ir,  0),  l)/x]  (*  x)(3),  [(iy,  0)  :=  dead,  (*r,  0)  :=  ((iy,  0),  0)],  1) 


Figure  5.  Sample  Stuck  Program,  continued  next  page 
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[contents] 

(((*»,  0),l),[(iy,0)  :=  dead,(t.,0)  :=  ((t„,0),0)],0)  -> 

(((iy,  0),  0),  [(iy,  0)  :=  dead,  (ix,  0)  :=  ((iy,  0),  0)],  0) 


[apply] 

((*  y)(3),  [(h,  0)  :=  dead,  (ix,  0)  :=  ((*,,  0),  0)],  0)  -* 

((*  ((iy,  0),  0))(3),  [(iy,  0)  :=  dead,  (»„  0)  :=  ((*„,  0),  0)],  0) 


[bindvar  (hi)] 

letvar  x  :=  ((iy,  0),  0)  in  (*  ((ix,  0),  1))(3),  [(tyj  0)  :=  dead, 

(t„  0)  :=  ((iy,  0),  0)],  1)  -  letvar  x  :=  ((iy,  0),  0)  in  (*  ((iy,  0),  0))(3), 

[(iy,0):=dead,(tr,0):=((iy,0),0)],l) 


(*  ((*,,  0),  0)),  [(iy,  0)  :=  dead,  (ix,  0)  :=  (({,,  0),  0)],  0)  ■/* 

((*  ((iy,  0),  0))(3),  [(iy,  0)  :=  dead,  (ix,  0)  :=  (ft,,  0),  0)],  0)  /> 

letvar  x  :=  (ft,,  0),  0)  in  [(ft,,  0),  l)/x]  (*  (ft,  0),  0))(3),  [(iy,  0)  :=  dead, 
ft:,0):=(ft,,0),0)],l)^ 

Figure  6.  Sample  Stuck  Program,  cont. 
4.        The  LOOP  Rule 

In  the  preliminary  design  of  the  transition  semantics  of  PolyC,  we  developed 
three  rules,  given  below,  to  specify  the  transitions  for  the  while-do  construct. 

(LOOP) 

(i)  (ei,fj,,S)  — >  (n, //,£')  (n  a  nonzero  integer) 


(while  ei  do  e2,/i,£)  — »  (e2;  while  ei  do  e2, //,£') 

(n)  (ei, /.,£)-+((), //,£') 

(while  ei  do  e2,/j,6)  — >  (unit,//,  £') 
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(Ill)  (eufi,8)  ->  K, //,£') 


(while  ei  do  e2,/z,<5>)  — *  (while  e[  do  ti,n',8') 


Gunter  develops  a  transition  semantics  for  an  imperative  programming  lan- 
guage called  Simple  Imperative  Programming  Language  (SIPL),  and  rules  (ill)  and 
(il)  above  are  closely  similiar  to  Gunter's  [Gun92]  .  There  is  a  subtle  difference 
though:  t\  of  while  e^  do  e2  is  not  evaluated  explicitly  in  Gunter's  system  but  its 
value  is  found  by  a  meaning  function  in  one  step.  In  our  system  we  explicitly  evaluate 
ei  and  for  this  reason  a  third  rule  had  to  be  added  to  the  system  as  shown  above.  But 
in  a  short  time  we  realized  that  this  third  rule  was  faulty.  Assume  in  an  evaluation 
of  a  program  we  reach  the  point  of  evaluating  the  expression, 

while  (a,  1)  :=  ((a,  1)  +  1);  1  do  e , 

which  increments  the  value  stored  in  address  a  and  then  evaluates  the  body  e.  This 
is  an  infinite  loop,  since  the  value  of  a  sequential  composition  ei;e2  is  the  value  of 
e2  and,  in  this  program,  e2  is  1  so  the  condition  is  always  true.  In  each  iteration, 
(a,  1)  :=  ((a,  1)  +  1);  1  and  e  must  be  evaluated.  But  this  is  not  achievable  with 
the  above  rules.  The  evaluation  starts  with  repeated  applications  of  rule  (ill)  until 
(a,  1)  :=  ((a,  1)  +  1);  1  evaluates  to  the  value  1.  At  this  point,  the  configuration 
is  (while  1  do  e,fi,S)  and  rule  (i)  is  applied  by  resulting  in  the  new  configuration 
(e;  while  1  do  e,/j,',8').  After  some  applications  of  COMPOSE,  e  evaluates  to  a  value 
and  then  the  configuration  (while  1  do  e,//",  8")  is  found.  This  completes  the  first 
iteration  of  the  loop;  but  notice  that  we  have  lost  the  original  program:  while  1  do  e 
is  different  than  while  (a,  1)  :=  ((a,  1)  -f  1);  1  do  e. 

To  fix  this  error,  we  developed  the  rule  below  by  using  a  continuation  instead 
of  the  three  rules: 
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(el5/z,<5)  ->  (e'l5 //,£') 


(while  ex  do  e2,fJ-,8)  — ♦ 
((Ax. if  a:  then 

e2;  while  ei  do  e2 
else 
unit 


In  this  rule,  the  A  abstraction  is  a  continuation.     We  simplify  the  rule  by 
/?  —  reducing  the  application  of  the  continuation  to  e\  and  arrive  at  the  rule  below. 

(while  ei  do  e2,/z,  £)  — >  (if  e^  then  e2;  while  t\  do  e2  else  unit,//',  £') 


This  is  the  rule  for  loop  construct  in  the  present  system. 

C.      CONCLUSION 

Although  we  have  a  better  handle  on  the  progress  of  the  evaluations  of  pro- 
grams, we  face  an  increase  in  the  number  of  transition  rules  in  the  system.  When 
we  want  to  add  the  binary  operations  to  the  language,  the  number  of  rules  increases 
greatly.  One  possible  effect  of  this  is  that  proofs  might  be  complicated  and  unneces- 
sarily long. 
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V.         CONCLUSIONS  AND  FUTURE  WORK 

A.  CONCLUSIONS 

1.  Type  Inference  Algorithm 

We  have  presented  an  ML-style  type  inference  algorithm  called  Wc  based  on 
Milner's  algorithm  W  [Mil78]  [DaM82].  An  implementation  of  Wc  has  been  given  in 
Appendix  as  part  of  an  interpreter  of  PolyC.  We  expect  a  correctness  proof  of  Wc  be 
straightforward  but  it  is  beyond  the  scope  of  this  thesis. 

2.  The  Transition  Semantics 

An  imperative  programming  language  with  first  class  pointers  should  have 
a  stronger  property  of  type  soundness  than  the  subject  reduction  property;  i.e.,  if 
a  closed  term  has  type  r,  then  the  evaluation  of  that  term  yields  a  value  of  type 
t  if  evaluation  terminates  successfully.  For  this  reason,  Smith  and  Volpano  prove 
soundness  of  the  PolyC  type  system  by  formulating  the  evaluation  rules  of  PolyC's 
natural  semantics  as  an  instance  of  a  recursive  function  called  eval  [SmV96a].  But 
this  proof  seems  to  be  slightly  informal.  To  establish  a  basis  for  a  more  formal  proof, 
we  developed  a  transition  semantics  for  PolyC  and  have  presented  it  in  this  thesis. 
We  believe  that  a  transition  semantics  exposes  more  information  about  the  course  of 
an  evaluation,  thus  making  it  possible  to  give  more  rigorous  soundness  arguments. 
But  a  transition  semantics  tends  to  introduce  a  large  number  of  rules  in  the  system, 
which  makes  proofs  more  cumbersome. 

B.  FUTURE  WORK 

1.        Formal  Soundness  Proof 

Volpano  and  Smith  are  currently  working  on  a  new  soundness  proof  with 
respect  to  natural  semantics  using  partial  evaluation  trees.  Pfenning  is  also  expected 
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to  give  a  soundness  proof1  using  the  Elf  programming  language,  which  is  based  on  the 
linear  logical  framework  concept  [Pfe96].  We  believe  a  soundness  proof  of  the  PolyC 
type  system  is  possible  using  the  transition  semantics  given  in  this  thesis  as  well. 

2.        Extending  PolyC 

Extending  PolyC  with  integer  and  boolean  operations  is  a  trivial  task,  and 
they  have  already  been  included  in  the  interpreter  implementation  given  in  Appendix. 
Polymorphic  records  and  variants,  on  the  other  hand,  require  modifications  to  the 
type  system  and  to  the  type  inference  algorithm.  Ohori  [Ohor95]  investigates  an 
ML-style  polymorphic  record  calculus  in  a  functional  setting  by  introducing  kinded 
quantification,  which  places  restrictions  on  possible  instantiations  of  type  variables. 
His  work  is  an  appealing  foundation  for  labeled  records  and  variants  in  the  PolyC 
language. 


1  Based  on  the  personal  communication  during  ESOP'96,  Linkoping  Sweden 
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APPENDIX.  SOURCE  PROGRAM  FOR  THE 

INTERPRETER 

1.  REMARKS 

Developing  a  type  inference  algorithm  has  led  to  an  implementation  of  Wc  to 
see  how  it  works  in  practice.  Besides  type  inference  we  also  implemented  the  natural 
semantics  of  Poly  C  given  in  [SmV96a]  and,  as  a  result,  we  have  created  an  interpreter 
for  PolyC.  During  implementation  we  tried  not  to  go  beyond  the  PolyC  calculus  and 
we  accomplished  this  except  for  SSL  lists  used  in  the  representation  of  formal  and 
actual  parameters. 

Annotations  throughout  the  source  code  are  kept  concise  by  assuming  that 
the  reader  will  have  some  knowledge  about  programming  language  theory  and  some 
experience  with  functional  programming. 

2.  SSL  CODE  FOR  THE  INTERPRETER 

*  This  interpreter  is  written  using  Synthesizer  Generator  * 

*  Release  4.2.  The  code  given  below  is  the  complete  code  that  * 

*  we  have  used  to  generate  the  interpreter  by  using  the  Makefile  * 

*  given  also  below.  For  space  efficiency,  we  put  all  the  files  * 

*  together  in  this  appendix,  but  each  file  is  clearly  * 

*  identifiable  by  the  header  provided  before  the  beginning  of  a  .  * 

*  file.  The  textual  appearance  order  of  files  in  this  appendix  is  * 

*  alphabetical  except  Makefile  which  is  given  last.  Following  are  * 

*  the  files:  * 

*  * 

*  assign. ssl  infer. ssl  lex.ssl  * 

*  assign_inf er . ssl  int. ssl  pair. ssl  * 

*  bool.ssl  int_inf er .ssl  pair_inf er . ssl  * 

*  bool_inf er . ssl  lambda. ssl  real. ssl  * 

*  eval.ssl  lambda_inf er .ssl  real_inf er . ssl  * 

*  explist.ssl  let. ssl  while. ssl  * 

*  id. ssl  let_inf er .ssl  while_inf er . ssl  * 

*  if. ssl  letarr.ssl  Makefile  * 
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*  if_infer.ssl  letarr_infer .ssl  * 

*  * 

*  Naming  of  files  are  intended  to  be  informative  what  is  in  there;  * 

*  for  instance  bool.ssl  gives  the  required  definitions  like  * 

*  abstract  syntax,  minimal  paranthesization,  unparsing  rules,  * 

*  template  commands  and  concrete  input  syntax  of  boolean  * 

*  operations.  Type  inference  for  these  operations  (constructs)  is  * 

*  in  bool_inf er . ssl .  * 

*  * 

*  It  should  be  noted  one  more  time  that  this  interpeter  extends  * 

*  Poly  C  [SmV96]  with  real  type  and  integer  and  bool  operations.  * 

*  * 


*  File  Name  :  assign. ssl  * 

*  Purpose    :  Definitions  for  Compose,  Assign,  AddrOf ,  Deref ,  * 

*  Unit,  Dead,  Uninit,  InvalidAddr  constructors  of  * 

*  exp  phylum.  * 

/*  InvalidAddr  is  returned  as  a  result  of  a  memory  lookup  */ 

/*  Abstract  syntax */ 

exp  :  Compose  (exp  exp) 

I  Assign  (exp  exp) 

I  AddrOf  (exp) 

I  Deref  (exp) 

I  UnitO 

I  Dead,  Uninit,  InvalidAddr  () 


/*  Minimal  parenthesization  */ 

exp  :    Compose  PP2(0) 

I    Assign  PP2(0) 

I    AddrOf  PP1(0) 

I    Deref  PP1(0) 
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/*  Unparsing 


*/ 


/* 

*  In  [SmV96] ,  *  is  used  for  dereferencing.  But  in  this 

*  implementation  we  use  !  for  dereferencing  and  *  for  integer 

*  multiplication. 
*/ 

exp  :    Compose 

Assign  ::=  0  "  °/.S (PUNCTUATION :  :=°/,S)  "  0  ] 

AddrOf 

Deref 

Unit 

Dead 

Uninit 

InvalidAddr 


=  0  ";  Jin"  @  ] 

=  0  "  °/0S  (PUNCTUATION  ::=°/,S)  " 
=  '7,S( OPERATOR :&°/.S)"  <§  ] 
=  " °/„S( OPERATOR :  !'/„S)"  @  ] 
=  '7.S (KEYWORD :unit°/„S)"  ] 
=  ,,0/,S  (KEYWORD  :dead°/.S)"  ] 
=  '7.S (KEYWORD :uninit°/.S)M  ] 
=  '7.S  (KEYWORD  :invalid°/.S)  °/.S 

(KEYWORD:  address°/„S)"  ] 


/*  Template  commands 
transform  exp 


*/ 


on 
on 
on 
on 
on 
on 
on 


; "  <exp> :  Compose (<exp>,  <exp>) , 

e;<exp>"  e  when  (e  !=  <exp>) :  Compose(e,  <exp>) , 

<exp>;e"  e  when  (e  !=  <exp>)  :  Compose(<exp>,  e) , 

:="  <exp>  :  Assign(<exp>,  <exp>) , 

ft"  <exp>  :  AddrOf (<exp>) , 

!"  <exp>:  Deref (<exp>), 

e  when  (e  !=  <exp>) :  Deref (e) 


i  " 


/*  Concrete  input  syntax  */ 

Exp  ::=  (Exp  ASSIGN  Exp)  {$$.abs  =  Assign(Exp$2 .abs,  Exp$3.abs);} 
I    (Exp  ' ; '    Exp)  {$$.abs  =  Compose (Exp$2. abs,  Exp$3.abs);} 
I    ('\'    Exp)  {Exp$l.abs  =  Deref (Exp$2 .abs) ;} 
I    ('&'  Exp)  {$$.abs  =  AddrOf (Exp$2. abs);} 
I    (UNIT)  {Exp. abs  =  Unit;} 


*  File  Name  :  assign_inf er.ssl  * 
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*  Purpose   :  Type  inference  for  the  cons' tors  given  in  assign. ssl  * 

*************************************************  *******************/ 

exp  :    Unit   { 

exp.typeAssignment  =  UnitType; 

exp . S  =  exp . s ; 

exp. partial  =  false; 
} 
I    Dead   { 

exp.typeAssignment  =  NullType; 

exp.S  =  FailSubst; 

exp. partial  =  false; 
} 
I   Uninit  { 

exp.typeAssignment  =  UniversalType; 

exp . S  =  exp . s ; 

exp. partial  =  false; 
} 
I    InvalidAddr  { 

exp.typeAssignment  =  UniversalType; 

exp . S  =  exp . s ; 

exp. partial  =  false; 
} 
I    Deref     { 

local  TYPEVAR  beta; 

beta  =  WeakVar(newsymi() ) ; 

exp$2.typeEnv  =  exp$l . typeEnv; 

exp$2 .letvars  =  exp$l .letvars; 

exp$2 .s  =  exp$l . s ; 

exp$l.S  =  Unify (RefType(TypeVar (beta)), 

exp$2.typeAssignment ,  exp$2.S); 

exp$l .typeAssignment=  ApplySubstToTypeExp(exp$l .S,  TypeVar( 

beta)) ; 

exp$l .partial  =  exp$2 .partial; 

exp$2.sv  =  exp$l.sv; 

exp$2  .  encl  =  exp$l  .end; 

exp$2.top  =  exp$l.top; 
} 
I    Assign  { 

exp$2 .typeEnv  =  exp$l .typeEnv; 

exp$2 .letvars  =  exp$l .letvars; 

exp$2 . s  =  exp$ 1 . s ; 

exp$3. typeEnv  =  ApplySubstToTypeEnv(exp$2.S ,  exp$l .typeEnv) ; 
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exp$3.1etvars  =  exp$l .letvars ; 
exp$3.s  = 

with(exp$2)  ( 

Ident (Identifier (i))  :  exp$2.S, 

Deref(e)  :  exp$2.S, 

Subscript (*,*)     :  exp$2.S, 

VoidExpO  :  exp$2.S, 

default  :  FailSubst 

); 

exp$l .typeAssignment  = 

ApplySubstToTypeExp(exp$l . S ,  exp$2 .typeAssignment) ; 
exp$l.S  = 

with(exp$2)  ( 

Ident (Identifier (i))  : 

InLVList (Identifier (i) ,  exp$l .letvars)  ? 
Unify (Inst Scheme (Lookup InTypeEnv(i , 
exp$l .typeEnv)) , exp$3 .typeAssignment ,exp$3.S) 
:  FailSubst,   /*  not  a  letvar  id  */ 
VoidExpO  : 

Unify (exp$2 . typeAssignment , exp$3 . typeAssignment , 
exp$3.S) , 
Deref(e)  : 

Unify (exp$2 . typeAssignment , exp$3 . typeAssignment , 
exp$3.S) , 
Subscript (*,*)  : 

Unify (exp$2. typeAssignment , exp$3 .typeAssignment, 
exp$3.S) , 
default  :  FailSubst 

); 

exp$l .partial  =  exp$2 .partial  I  I  exp$3 .partial; 

exp$3.sv  =  exp$l.sv; 

exp$2.sv  =  exp$l.sv; 

exp$3 . encl  =  exp$ 1 . encl ; 

exp$2 . encl  =  exp$ 1 . encl ; 

exp$2.top  =  false; 

exp$3.top  =  exp$l.top; 
} 

AddrOf    { 
local  TYPEEXP  tau; 
exp$2. typeEnv  =  exp$l .typeEnv; 
exp$2 .letvars  =  exp$l .letvars; 
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exp$2.s  =  exp$l.s; 
exp$l .  S  = 

with(exp$2)  ( 

Ident (Identifier (i) )  : 

InLVList (Identifier (i) , exp$l . letvars) 7 
Unify (TypeVar ( WeakVar (newsymi ( ) ) ) , t au , exp$ 1 . s ) 
:  FailSubst,  /*  not  a  letvar  id  */ 
VoidExpO       :  exp$2.S, 
Deref(*)        :  exp$2.S, 
Subscript (*,  *)   :  exp$2.S, 
default         :  FailSubst 

); 

exp$l .typeAssignment  =  RefType(tau) ; 
exp$l .partial  =  exp$2 .partial; 

tau  = 

with(exp$2)( 

Ident (Identif ier(i) )  : 
InstScheme(LookupInTypeEnv(i ,exp$l . typeEnv) ) , 
VoidExpO  :  TypeVar (WeakVar (newsymi ())) , 
Deref(*)   :  exp$2 .typeAssignment , 

Subscript (*,  *)  :  exp$2 .typeAssignment , 
default  :  NullType 

); 

exp$2.sv  =  exp$l.sv; 
exp$2.encl  =  exp$l.encl; 
exp$2.top  =  exp$l.top; 

} 
Compose  { 

exp$2 .typeEnv  =  exp$l .typeEnv; 

exp$2 .letvars  =  exp$l .letvars; 

exp$2.s  =  exp$l.s; 

exp$3.s  =  exp$2.S; 

exp$3. letvars  =  exp$l .letvars ; 

exp$3. typeEnv  =  ApplySubstToTypeEnv(exp$2 . S, 

exp$l .typeEnv) ; 
exp$l .S  =  exp$3.S; 

exp$l .typeAssignment  =  exp$3 .typeAssignment ; 
exp$l .partial  =  exp$2 .partial  II  exp$3 .partial ; 
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exp$3 . sv  =  exp$l.sv; 
exp$2.sv  =  exp$l.sv; 
exp$3.encl  =  exp$l.encl; 
exp$2.encl  =  exp$l.encl; 
exp$2.top  =  false; 
exp$3.top  =  exp$l.top; 
} 


exp  :   Deref  {in  TypeErrors  on  (exp$l.S  ==  FailSubst  && 

exp$2.S  !=  FailSubst)  ;}  [  TypeErrors  <§  :  "Deref °/,n"~  ] 
I   Assign  {in  TypeErrors  on  (exp$l.S  ==  FailSubst  && 

exp$2.S  !=  FailSubst  &&  exp$3.S  !=  FailSubst);} 
[  TypeErrors  @  :  "Assign°/,n"~~  ] 
I   AddrOf  {in  TypeErrors  on  (exp$l.S  ==  FailSubst  && 

exp$2.S  !=  FailSubst);}  [  TypeErrors  <§  :  "AddrOf'/.n"~  ] 


*  File  Name  :  bool.ssl  * 

*  Purpose    :  Boolean  operations.  * 

/*  Abstract  syntax */ 

exp  :   Not (exp) 

I   And,  Or,  Equal,  NotEqual(exp  exp) 


/*  Minimal  parenthesization  */ 

exp  :   Not   PP1(9) 

I   And   PP2(3) 

I   Or   PP2(2) 

I   Equal   PP2(4) 

I   NotEqual  PP2(4) 


/*  Unparsing */ 

exp  :   Not   [~  :  :=  '"/.S (PUNCTUATION:"  lp  "7„S (OPERATOR : °/„<not>,/,S) "  @ 
"°/.S (PUNCTUATION:"  rp  "7.S)"] 
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I   And   [*  ::=  "/.S  (PUNCTUATION :  "  lp  '7„S)"  0  "  °/.S  (OPERATOR  :&&'/.S) 

0  "°/,S  (PUNCTUATION:"  rp  '7.S)"] 
I   Or    ["  ::=  "%S  (PUNCTUATION :  "  lp  "°/0S)"  0  "  °/„S  (OPERATOR:  I  I  °/„S) 

Q  "°/.S (PUNCTUATION:"  rp  '7.S)"] 
I   Equal  [**  ::=  '"/.S (PUNCTUATION :  "  lp  "°/.S)"  <9  "  °/„S (OPERATOR :  ='/.S) 

0  '"/.S (PUNCTUATION:"  rp  "°/,S)"] 
I   NotEqual   ["  :  :=  "'/,S (PUNCTUATION : "  lp  U,/.S)"  0  "  °/,S (OPERATOR: 
y.<ne>y.S)  "  <S  " 7, S (PUNCTUATION:"  rp  ,,0/„S)"] 


/*  Template  commands  */ 

transform  exp 


on 
on 
on 
on 

on 


~"  <exp>  :  Not(<exp>) , 
&&"  <exp>  :  And(<exp>,  <exp>) , 
I  I"  <exp>  :  Or(<exp>,  <exp>) , 
="  <exp>  :  Equal(<exp>,  <exp>) , 
<>"  <exp>  :  NotEqual (<exp>,  <exp>) 


/*  Concrete  input  syntax  */ 

Exp  ::=    ('"'  Exp)    {  Exp$l.abs  =  Not (Exp$2. abs) ;  } 
I    (Exp  LOGICALAND  Exp) 

{  Exp$l.abs  =  And(Exp$2.abs,  Exp$3.abs);  } 
I    (Exp  LOGICALOR  Exp) 

{  Exp$l.abs  =  0r(Exp$2.abs,  Exp$3.abs);  } 
I    (Exp  '='  Exp  prec  '=') 

{  Exp$l.abs  =  Equal(Exp$2.abs,  Exp$3.abs);  } 
I    (Exp  NOTEQUAL  Exp  prec  NOTEQUAL) 

{  Exp$l.abs  =  NotEqual (Exp$2. abs,  Exp$3.abs);  } 


*  File  Name  :  bool_inf er . ssl  * 

*  Purpose    :  Type  inference  for  the  cons 'tors  given  in  bool.ssl    * 

exp  :   Not   { 

exp$2 . typeEnv  =  exp$l . typeEnv; 
exp$2 . letvars  =  exp$l . letvars ; 
exp$2.s  =  exp$l.s; 
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exp$l.S  =  Unify (exp$2 .typeAssignment , 
IntType,  exp$2.S); 

exp$l .typeAssignment  =  IntType; 

exp$l .partial  =  exp$2 .partial; 

exp$2.sv  =  exp$l.sv; 

exp$2.encl  =  exp$l.encl; 

exp$2.top  =  exp$l.top; 

} 
And,  Or  { 

exp$2 . typeEnv  =  exp$l . typeEnv; 

exp$2 . letvars  =  exp$l .letvars; 

exp$3.1etvars  =  exp$l .letvars; 

exp$2.s  =  exp$l.s; 

exp$3.s  =  Unify (exp$2 .typeAssignment , 
IntType,  exp$2.S) ; 

exp$3. typeEnv  =  ApplySubstToTypeEnv(exp$3.s, 
exp$l .typeEnv) ; 

exp$l.S  =  Unify (exp$3. typeAssignment, 
IntType,  exp$3.S); 

exp$l .typeAssignment  =  IntType; 

exp$l .partial  =  exp$2 .partial  I  I  exp$3 .partial; 

exp$3.sv  =  exp$l.sv; 

exp$2 . sv  =  exp$l.sv; 

exp$3 . encl  =  exp$l.encl; 

exp$2.encl  =  exp$l.encl; 

exp$2.top  =  false; 

exp$3.top  =  exp$l.top; 

} 
Equal,  NotEqual  { 

exp$2 .typeEnv  =  exp$l .typeEnv; 

exp$2 .letvars  =  exp$l .letvars ; 

exp$3 . letvars  =  exp$l .letvars; 

exp$2.s  =  exp$l.s; 

exp$3.s  =  exp$2.S; 

exp$3. typeEnv  =  ApplySubstToTypeEnv(exp$2.S,  exp$l .typeEnv) ; 

exp$l.S  =  Unify (exp$2 .typeAssignment ,  exp$3. typeAssignment , 
exp$3.S) ; 

exp$l .typeAssignment  =  IntType; 

exp$l .partial  =  exp$2 .partial  I  I  exp$3. partial; 

exp$3 . sv  =  exp$l.sv; 

exp$2.sv  =  exp$l.sv; 

exp$3.encl  =  exp$l.encl; 
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exp$2.encl  =  exp$l  .end; 
exp$2.top  =  false; 
exp$3.top  =  exp$l.top; 
} 


exp  :   Not   {in  TypeErrors  on  (exp$l.S  ==  FailSubst  && 

exp$2.S  !=  FailSubst);  }  [  TypeErrors  <3  :  "Not'/,n"  *  ] 
I   And,  Or  {in  TypeErrors  on  (exp$l.S  ==  FailSubst  && 

exp$2.S  !=  FailSubst  &&  exp$3.S  !=  FailSubst);} 
I   And    [  TypeErrors  @  :  "And'/.n"  ~   ~  ] 
I   Or    [  TypeErrors  <S  :  "Or°/,n"  ~  "  ] 
I   Equal,  NotEqual  {in  TypeErrors  on  (exp$l.S  ==  FailSubst  && 

exp$2.S  !=  FailSubst  &&  exp$3.S  !=  FailSubst);} 
I   Equal    [  TypeErrors  @  :  "Equaiyon"     ] 
I   NotEqual  [  TypeErrors  @  :  MNotEqual0/.n"  "  "  ] 


*  File  Name  :  eval.ssl  * 

*  Purpose    :  Implements  the  natural  semantics  (structured  * 

*  operational  semantics)  of  Poly  C  wrt  the  rules  * 

*  given  in  [SmV96] .  User  has  the  option  to  evaluate  * 

*  a  program  or  not  by  clicking  on  the  button  labeled  * 

*  eval-on.  * 

*  When  the  evaluation  of  a  program  gets  stuck  due  * 

*  to  one  of  four  error  cases  described  in  [SmV96]  * 

*  the  interpreter  returns  the  partially  evaluated  * 

*  program  as  a  result  for  debugging  purposes.  * 

MEMORY   :  NullMemO  [<B  :  ] 

I  MemConcat (LOCATION  exp  MEMORY)  { 
INHSILENCE(exp) 
}   [0  :  "•/,{["  0  "  \<nghtarrow>"  0  "]°/.o"  S  "7.}"] 


/*  Result  of  an  evaluation  */ 


50 


EVAL   :  EvalPair(exp  MEMORY) { 
INHSILENCE(exp) 
}    [~  :  M%S (PUNCTUATION :(y.S)"  0  '7.S (PUNCTUATION :  ,°/„S)  °/„o"  0 
'"/.S  (PUNCTUATION  O'/.S)"  ] 


/* 

*  We  have  two  different  array  subscript  constructors  :  one  returns 

*  a  value  as  a  result  of  the  evaluation  (r-value)  and  the  other 

*  returns  a  Varloc  (1-value) .  Having  these  two  constructors  is 

*  an  efficient  way  of  implementing  these  two  different  occurrences. 

*  Otherwise,  if  we  had  only  one  constructor  that  returns  Varloc 

*  then  the  result  of  the  evaluation  of  an  expression  occuring 

*  in  r-value  context  must  be  checked  if  the  result  is  a  Varloc  which 

*  must  be  dereferenced  with  an  extra  step. 
*/ 

/*  We  add  basic  logical  operations  to  the  language.  They 

*  implement  the  same  C  semantics  as  one  would  expect. 

*  False  is  denoted  by  0  and  True  is  denoted  by  a  non-zero 

*  value;  a  logical  operation  constructors  returns  1  if  the 

*  result  of  the  operation  is  True. 
*/ 

EVAL  eval  (exp  e,  MEMORY  mu)  { 
with  (e)  ( 
Varloc(l)   : 

EvalPair(MemoryLookUp(l,  mu)  ,  mu)  , 
Sum(el,  e2) : 

let  EvalPair(vl,  mul)  =  eval (el,  mu)  in  ( 

let  EvalPair(v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

IntOp(il) :  with  (v2)  ( 

Int0p(i2):  EvalPair(IntOp(il  +  i2) ,  mu2) , 
default   :  EvalPair(Sum(vl,  v2) ,  mu) 

), 
default:  EvalPair(Sum(vl ,e2) ,  mu) 

))), 

PtrAdd(el,e2) : 

let  EvalPair(vl,  mul)  =  eval (el,  mu)  in  ( 

let  EvalPair(v2,  mu2)  =  eval(e2,  mul)  in  ( 
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with  (vl)  ( 

Refloc(Loc(s,o)) :  with  (v2)  ( 

IntOp(i)  :  EvalPair (Refloc(Loc(s,INTtoSTR( 

STRtoINT(o)  +  i))),  mu2), 
default  :  EvalPair(PtrAdd(vl,v2) ,mu) 

). 

default:  EvalPair(PtrAdd(vl ,  e2) ,  mu) 

))), 
Subscript (el,  e2) : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair(v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

Ref loc(Loc(s,o)) : 
with  (v2)  ( 
IntOp(i) : 

EvalPair(MemoryLookUp(Loc(s,INTtoSTR( 
STRtoINT(o)+i)) ,   mu2),   mu2) , 
default    :    EvalPair (Subscript (vl ,v2) ,mu) 

), 

default   :  EvalPair (Subscript (vl ,e2) ,  mu) 

SubscriptL(el,  e2) : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair (v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

Refloc(Loc(s,o)) :  with  (v2)  ( 

IntOp(i)  :  EvalPair (Varloc(Loc(s,INTtoSTR( 

STRtoINT(o)+i))),  mu2), 
default   :  EvalPair (SubscriptL(vl ,  v2) ,  mu) 

), 
default   :  EvalPair(SubscriptL(vl ,  e2) ,  mu) 

))), 

Diff (el,  e2) : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair (v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

IntOp(il)  :  with  (v2)  ( 

Int0p(i2):  EvalPair(IntOp(il  -  i2) ,  mu2) , 
default:  EvalPair (Diff (vl ,  v2) ,  mu) 

), 
default:  EvalPair (Diff (vl ,  e2) ,  mu) 
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))), 

Prod(el,  e2) : 

let  EvalPair(vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair(v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

IntOp(il) :  with  (v2)  ( 

Int0p(i2):  EvalPair(IntOp(il  *  i2) ,  mu2) , 
default:  EvalPair (Prod(vl ,  v2),  mu) 

), 

default:  EvalPair (Prod(vl,  e2)  ,  mu) 

))), 
LessThan(el,  e2) : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair (v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

IntOp(il) :  with  (v2)  ( 

Int0p(i2):  EvalPair(IntOp((il  <  i2)  ?  1 

:  0),  mu2), 
default:  EvalPair(LessThan(vl ,  v2) ,  mu) 

), 

default:  EvalPair (LessThan(vl,  e2)  ,  mu) 

))), 

LessThanOrEqual(el ,  e2) : 

let  EvalPair(vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair (v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

IntOp(il) :  with  (v2)  ( 

Int0p(i2):   EvalPair(IntOp((il  <=  i2)    7   1:    0), 

mu2)  , 

default:  EvalPair (LessThanOrEqual(vl,  v2)  ,  mu 

), 

default:  EvalPair (LessThanOrEqual(vl ,  e2)  ,  mu) 

Great erThan( el ,  e2) : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair (v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

IntOp(il) :  with  (v2)  ( 

Int0p(i2):   EvalPair(IntOp((il  >   i2)?    1:0), 

mu2)  , 
default:  EvalPair(GreaterThan(vl ,  v2) ,  mu) 
), 
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default:  EvalPair (GreaterThan(vl,  e2) ,  mu) 

))), 
GreaterThanOrEqual(el,  e2) : 

let  EvalPair(vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair(v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

IntOp(il) :  with  (v2)  ( 

Int0p(i2):   EvalPair(IntOp((il  >=  i2)    ?   1:    0), 

mu2)  , 

default:  EvalPair(GreaterThanOrEqual(vl,  v2)  , 

mu) 

), 

default:  EvalPair (Great erThanOrEqual (vl ,  e2) ,  mu) 

))), 

Quot (el,  e2)  : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair (v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

IntOp(il) :  with  (v2)  ( 

Int0p(i2):  (i2  ==  0)  ?  EvalPair(Quot (vl,  v2) ,mu) 

:  EvalPair(IntOp(il  /  i2) ,  mu2) , 
default:  EvalPair (Quot (vl ,  v2) ,  mu) 

), 

default:  EvalPair (Quot (vl,  e2) ,  mu) 

))), 
Not(e):  let  EvalPair(v,  mul)  =  eval(e,  mu)  in  ( 
with  (v)  ( 

IntOp(b):  EvalPair (Int0p((b  ==  0)  ?  1:  0),  mul), 

default:  EvalPair (Not (v) ,  mu) 

)), 

And(el,  e2) : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair (v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

IntOp(bl) :  with  (v2)  ( 

Int0p(b2):  EvalPair (Int Op (( (bl  !=  0)  && 

(b2  !=  0))  ?  1:  0),  mu2), 
default:  EvalPair (And (vl ,  v2) ,  mu) 

), 
default:  EvalPair (And(vl,  e2)  ,  mu) 

))), 
0r(el,  e2) : 
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let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair (v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

IntOp(bl)  :  with  (v2)  ( 

Int0p(b2):  EvalPair(IntOp(((bl  !=  0)  I  I 
(b2  !=  0))  ?  1:  0),  mu2) , 
default:  EvalPair(Or(vl ,  v2) ,  mu) 

>, 

default:  EvalPair(Or(vl ,  e2) ,  mu) 

))), 
Equal (el,  e2) : 

let  EvalPair(vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair(v2,  mu2)  =  eval(e2,  mul)  in  ( 

Value(vl)  ?  Value(v2)  ?  EvalPair(IntOp( (vl  ==  v2)  ?  1 

:  0) ,  mu2) 

:  EvalPair (Equal (vl ,  v2)  ,  mu) 
:  EvalPair (Equal (vl,  e2) ,  mu) 

)), 
NotEquaKel,  e2)  : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair (v2,  mu2)  =  eval(e2,  mul)  in  ( 

Value(vl)  ?  Value(v2)  7  EvalPair (Int0p( (vl  !=  v2)  7  1 

:  0) ,  mu2) 
:  EvalPair (NotEqual(vl,  v2) ,  mu) 
:  EvalPair (NotEqual (vl ,  e2) ,  mu) 

)), 
Deref (el) : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 
with  (vl)  ( 

Refloc(l)  :  EvalPair (MemoryLookUpQ,  mul),  mul), 
default:  EvalPair (Deref (vl) ,  mu) 

)), 
Call(el,al)  : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 
let  EvalPair (v2,  mu2)  =  EvalList(al,  mul, 

ActualParamListNilO)  in  ( 
with(vl) ( 

Lambda(x,e2) :  with(v2) ( 

Call (Unit,  a2) :  eval(ReplaceWithActuals( 

a2,  x,  e2) ,  mu2) , 
Call (Dead,  a2) :  EvalPair (Call(vl ,  a2) ,  mu2) , 
default:  EvalPair (Call (vl , 
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v2: :ActualParamListNil) ,mu) 

/*  never  happens  */ 

), 
default:  EvalPair(Call(vl ,  al) ,  mu) 

))), 
Assign(el ,  e2) : 
with(el)  ( 
Deref (el) : 

let  EvalPair(vl,  mul)  =  eval(el,  mu)  in  ( 

let  EvalPair(v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

Refloc(l):  with  (MemoryLookUp(l,  mu2))  ( 
Dead:  EvalPair(Assign(Deref (Dead) ,  e2) , 

mu)  , 
default:  Value (v2)  ? 

EvalPair(v2,  UpdateMemory(l ,  v2 ,  mu2)) 

:  EvalPair(Assign(Varloc(l) ,  v2) ,  mu) 

), 

default :EvalPair (Assign (Deref (vl) ,  e2) ,  mu) 

))), 
Subscript (e3,  e4) : 

let  EvalPair(vl,  mul)  = 

eval(SubscriptL(e3,e4) ,  mu)  in  ( 
let  EvalPair(v2,  mu2)  =  eval(e2,  mul)  in  ( 
with  (vl)  ( 

Varloc(l):  Value(v2)  ?  EvalPair(v2, 

UpdateMemory(l,  v2,  mu2)) 
:  EvalPair(Assign(vl ,v2) ,  mu) , 
default   :  EvalPair(Assign(vl ,  e2)  ,  mu) 

))), 
Varloc(l) : 

let  EvalPair(v,  mul)  =  eval(e2,  mu)  in  ( 

Value(v)  ?  EvalPair(v,  UpdateMemory (1,  v,  mul)) 
:  EvalPair(Assign(el , v) ,  mu) ) , 
default:  EvalPair(e,  mu) 

), 
AddrOf (el): 
with(el)  ( 
Deref (e2) : 

let  EvalPair(vl,  mul)  =  eval(e2,  mu)  in  ( 
with  (vl)  ( 

Refloc(l):  EvalPair(vl,  mul), 
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default   :  EvalPair (AddrOf (Deref (vl)) ,  mu) 
) 

Subscript (e2,  e3) : 

let  EvalPair(vl,  mul)  =  eval(SubscriptL(e2,  e3) ,mu)  in  ( 
with  (vl)  ( 

Varloc(l):  EvalPair(Refloc(l) ,  mul), 

default   :  EvalPair (AddrOf (vl) ,  mu) 
) 

). 

Varloc(l) :  EvalPair(Ref loc(l) ,  mu) , 
default   :  EvalPair (e,  mu) 

), 
Compose(el,  e2) : 

let  EvalPair (v,  mul)  =  eval(el,  mu)  in  ( 

Value(v)  ?  eval(e2,  mul):  EvalPair(Compose(v,  e2) ,  mu) 

), 
While(el,  e2) : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 
with  (vl)  ( 

IntOp(n) :  (n  !=  0)  ? 

let  EvalPair(v2,  mu2)  =  eval(e2,  mul)  in  ( 
Value(v2)  ?  eval(e,  mu2) 

:  EvalPair(While(vl,  v2) ,  mu)) 
:  EvalPair (Unit ,  mul), 
default:  EvalPair (While(vl,  e2) ,  mu) 

)), 
Cond(el,  e2,  e3) : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 
with  (vl)  ( 

IntOp(n):  eval((n  !=  0)  ?  e2:  e3,  mul), 
default:  eval(Cond(vl,  e2,  e3) ,  mu) 

)), 

LetVar(x,  el,  e2) : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 
Value(vl)  ? 

let  1  =  (newsymiO)  [2:]  in  ( 
let  EvalPair (v2,  mu2)  = 

eval(ReplaceIn(Varloc(Loc(l,INTtoSTR(0))) ,  x,  e2) , 
UpdateMemory(Loc(l,  INTtoSTR(O)) ,  vl,  mul))  in  ( 
Value(v2)  ?  EvalPair(v2,  UpdateMemory (Loc(l, 
INTtoSTR(O)) ,  Dead,  mu2)):  EvalPair(v2,  mu))) 
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>; 


:  EvalPair (LetVar(x,  vl,  e2) ,  mu)), 
Let (x,  el ,  e2) : 

let  EvalPair(vl,  mul)  =  eval(el,  mu)  in  ( 

Value(vl)  ?  eval(ReplaceIn(vl,  x,  e2) ,  mul) 
:  EvalPair (Let (x,  vl,  e2)  ,  mu) 

), 
LetArr(x,  el ,  e2) : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 
with(vl)  ( 

IntOp(n) :  (n  >  0)  ? 

let  EvalPair(v2,  mu2)  =  InitializeArray(n,  mul)  in  ( 
let  EvalPair(v3,  mu3)  =  eval(ReplaceIn(v2,  x,  e2)  , 

mu2)  in  ( 
Value (v3)  ?  EvalPair (v3,MarkDead(n,  v2,  mu3)) 
:  EvalPair (v3,  mu2) 

)) 

:  EvalPair (LetArr(x,  vl,  e2) ,  mu) ,  /*  n  <=  0*/ 
default:  EvalPair (LetArr(x,  vl,  e2) ,  mu) 

)), 

Pair(el,  e2)  : 

let  EvalPair (vl,  mul)  =  eval(el,  mu)  in  ( 

Value (vl)  ?  let  EvalPair (v2,  mu2)  =  eval(e2,  mul)  in  ( 
Value(v2)  ?  EvalPair (Pair(vl,  v2) ,  mu2) 
:  EvalPair(Pair(vl ,  v2) ,  mu) 
) 
:  EvalPair (e,  mu) 

), 

default:  EvalPair(e,  mu) 

) 


/*  Is  the  expression  e  a  syntactic  value?  */ 
BOOL  Value (exp  e)  { 


with(e)  ( 

Lambda(*,*) : 

true, 

Int0p(*)    : 

true, 

Real0p(*)   : 

true, 

Refloc(*)   : 

true, 

Ident(*)    : 

true, 

Unit       : 

true, 

default    : 

false 

) 
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}; 

/*  Replace  all  free  occurrences  of  formal  parameters  given  by 

*  f  in  e  with  the  actual  parameters  given  by  a. 
*/ 

exp  ReplaceWithActuals(actualParamList  a,  f ormalParamList  f,  exp  e)  { 
with(a)  ( 

ActualParamListPair(vl,  restl) : 
with(f)  ( 

FormalParamListPair(x,  rest2)  : 

Replaceln(vl ,  x,  ReplaceWithActuals (restl ,  rest2,  e)), 
default :  e 

), 
default :  e 

) 

}; 

/*  [v/x] e  —  replace  all  free  occurrences  of  x  in  e  by  v     */ 
exp  Replaceln  (exp  v,  Id  x,  exp  e)  { 
with  (x)  ( 

IdNullO  :  e, 

Identif ier(y) :  ReplaceAux(v,  y,  e) 
) 

}; 

exp  ReplaceAux  (exp  v,  ID  id,  exp  e)  { 
with  (e)  ( 

Ident (Identif ier(x)) :  (id  ==  x)  ?  v:  e, 

AddrOf(el):  AddrOf (ReplaceAux(v,  id,  el)), 

Assign(el,e2) :  Assign (ReplaceAux  (v,  id,  el) , ReplaceAux  (v,  id 

,e2)), 
Deref(el):  Deref (ReplaceAux (v,  id,  el)), 
Compose(el,  e2) :  Compose (ReplaceAux (v,  id,  el),  ReplaceAux(v, 

id,e2)), 
Lambda(f,  el):  IsFormalParameter(id,  f)  ?  e 

:  Lambda(f,  ReplaceAux(v,  id,  el)), 
While(el,  e2) :  While (ReplaceAux(v,  id,  el) ,ReplaceAux(v,  id,  e2) 

>, 

Let (Identif ier(x) ,  el,  e2) : 

(id  ==  x)  ?  Let (Identif ier(x) ,  ReplaceAux(v,  id,  el),  e2) 
:  Let (Identif ier(x) ,  ReplaceAux(v,  id,  el), 
ReplaceAux(v,  id,  e2)), 
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LetVar(Identif ier(x) ,  el,  e2) : 

(id  ==  x)  ?  LetVar(Identif ier(x) ,  ReplaceAux(v,  id,  el),  e2) 
:  LetVar(Identif ier(x) ,  ReplaceAux(v,  id,  el), 
ReplaceAux(v,  id,  e2)), 
LetArr(Identif ier(x) ,  el,  e2) : 

(id  ==  x)  ?  LetVar(Identif ier(x) ,  ReplaceAux(v,  id,  el), 

e2) 
:  LetArr(Identif ier(x) ,  ReplaceAux(v,  id,  el) , 

ReplaceAux(v,  id,  e2)), 
PtrAdd(el,  e2) :  PtrAdd(ReplaceAux(v,  id,  el),  ReplaceAux(v,  id, 

e2)), 
Subscript(el,  e2) :  Subscript (ReplaceAux(v,  id,  el),  ReplaceAux( 

v,  id,  e2)), 
SubscriptL(el,  e2) :  SubscriptL(ReplaceAux(v,  id,  el) ,ReplaceAux( 

v,  id,  e2)), 
Pair(el,  e2) :  Pair(ReplaceAux(v,  id,  el),  ReplaceAux(v,  id,  e2) 

), 
Sura(el,  e2)  :  Sum(ReplaceAux(v,  id,  el),  ReplaceAux(v,  id,  e2)), 
Diff(el,  e2) :  Diff (ReplaceAux(v,  id,  el),  ReplaceAux(v,  id,  e2 

)), 

Prod(el,  e2) :  Prod(ReplaceAux(v,  id,  el),  ReplaceAux(v,  id,  e2) 

), 

Quot(el,  e2) :  Quot (ReplaceAux(v,  id,  el),  ReplaceAux(v,  id,  e2) 

), 

LessThan(el,  e2) : 

LessThan(ReplaceAux(v,  id,  el),  ReplaceAux(v,  id,  e2)), 
LessThanOrEqual(el ,  e2) : 

LessThanOrEqual(ReplaceAux(v,  id,  el),  ReplaceAux(v,  id,  e2)), 
GreaterThan(el ,  e2) : 

GreaterThan(ReplaceAux(v,  id,  el),  ReplaceAux(v,  id,  e2)), 
Great erThanOrEqual (el ,  e2) : 

GreaterThanOrEqual(ReplaceAux(v,  id,  el),  ReplaceAux(v, id,e2) 

), 

Not(e):  Not (ReplaceAux(v,  id,  e)), 

And(el,  e2) :  And(ReplaceAux(v,  id,  el),  ReplaceAux(v,  id,  e2)), 
Or (el,  e2) :  Or(ReplaceAux(v,  id,  el),  ReplaceAux(v,  id,  e2)), 
Equal(el,  e2) :  Equal (ReplaceAux(v,  id,  el),  ReplaceAux(v, id,e2) 

), 

NotEqual(el,  e2) :  NotEqual(ReplaceAux(v,  id,  el), 

ReplaceAux(v,  id,  e2)), 
Cond(el,  e2 ,  e3) :  Cond(  ReplaceAux(v ,  id,  el),  ReplaceAux(v,  id, 

e2) ,  ReplaceAux(v,  id,  e3)), 
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Call(el,  1):  Call (ReplaceAux(v,  id,  el),  ReplacelnList (v,  id,l) 

), 
default :  e 

) 

}; 

/*  Does  id  occur  in  formal  parameter  list  x  ?  */ 
BOOL  IsFormalParameter(ID  id,  f ormalParamList  x)  { 
with  (x)  ( 

FormalParamListPairddentif  ier(v) ,  rest)  : 

(id  ==  v)  ?  true:  IsFormalParameter(id,  rest), 
default:  false 
) 

}; 


/*  Replace  all  free  occurrences  of  id  in  each  element  e  of  1  */ 
actualParamList  ReplacelnList (exp  v,  ID  id,  actualParamList  1)  { 
with  (1)  ( 

ActualParamListMil:  1, 
ActualParamListPair(e,  rest): 

ReplaceAux(v,  id,  e) : :  ReplacelnList (v,  id,  rest), 
) 

}; 


/*  We  evaluate  the  actual  paramaters  11  in  order  and  put  the 

*  results  into  another  list  12.  We  use  the  constructor  Call 

*  as  a  placeholder  to  return  the  result  since  it  is  the  only 

*  expression  constructor  with  a  actualParamList  type  of  argument. 

*  The  first  argument  of  Call  is  used  to  indicate  if  the 

*  evaluation  of  11  is  completed  successfully.  If  so,  we  return 

*  Unit  as  the  first  argument  and  12  as  the  second  argument, 

*  otherwise  we  return  Dead  as  the  first  argument  and  a  partially 

*  evaluated  list  as  the  second  argument. 
*/ 

EVAL  EvalList(  actualParamList  11,  MEMORY  mu,  actualParamList  12)  { 
with(ll)  ( 

ActualParamListPair (e ,  rest): 

let  EvalPair(v,  mul)  =  eval(e,  mu)  in  ( 
Value (v)  ?  EvalList(rest,  mul,  v::12) 
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:  EvalPair (Call (Dead,  ReverseList (ReverseList ( 
rest)  0  v: :12)),  mul)) , 
default:  EvalPair (Call (Unit , ReverseList (12)) ,  mu) 
) 

}; 

actualParamList  ReverseList (actualParamList  1)  { 
with(l)  ( 

ActiialParamListPair(v,  rest):  ReverseList  (rest)  @ 

ActualParamListPair(v,  ActualParamListNilO ) , 
default :  1 
) 

}; 


/*  mu[l:=v]  —  update (extend)  memory  mu  with  binding  l:=v     */ 

MEMORY  UpdateMemory  (LOCATION  1,  exp  v,  MEMORY  mu)  { 
with  (mu)  ( 

NullMemO  :  MemConcat(l,  v,  mu)  , 

MemConcat(12,  v2,  mu2) :  (1  ==  12)  ?  MemConcat(l,  v,  mu2) 

:  MemConcat(12,  v2,  UpdateMemory (1,  v,  mu2)), 
) 


exp  MemoryLookUp  (LOCATION  1,  MEMORY  mu)  { 
with  (mu)  ( 

MemConcat(12,  v2,  mu2) :  (1  ==  12)  ?  v2:  MemoryLookUp (1,  mu2) , 
default:  InvalidAddr  /*Deref erence  of  a  non-existence  address  */ 
) 

}; 

/*  Allocate  memory  cells  for  the  elements  of  an  array  of  size  n  and  */ 
/*  initialize  them  to  Uninit.*/ 
EVAL  InitializeArray(INT  n,  MEMORY  mu)  { 
let  1  =  (newsymiO)  [2:]  in  ( 

let  mul  =  InitializeArrayAux(n  -  1,  1,  UpdateMemory (Loc(l, 
INTtoSTR(n-l)),  Uninit,  mu))  in  ( 
EvalPair(Refloc(Loc(l,INTtoSTR(0))) ,  mul) 
)) 
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}; 

MEMORY  InitializeArrayAux(INT  n,  SEGMENT  s,  MEMORY  mu)  { 
(n  ==  0)  ?  mu:  InitializeArrayAux(n  -  1,  s, 

UpdateMemory(Loc(s,INTtoSTR(n-l)),  Uninit ,  mu)) 

}; 


/*  Mark  the  cells  allocated  for  the  elements  of  the  array  as  Dead  */ 
MEMORY  MarkDead(INT  n,  exp  e,   MEMORY  mu)  { 
with(e)  ( 

Ref loc(Loc(s,*)) :  MarkDeadAux(n,  s,  mu) , 
default   :  mu  /*  should  never  be  reached  */ 
) 

>; 

MEMORY  MarkDeadAux(INT  n,  SEGMENT  s,   MEMORY  mu)  { 
(n  ==  0)  ?  mu:  MarkDeadAux(n-l ,  s, 

UpdateMemory(Loc(s,INTtoSTR(n-l)) ,  Dead,  mu)) 

}; 


*  File  Name  :  explist.ssl  * 

*  Purpose    :  A  program  is  an  explist  composed  of  terms.  * 

root  expList; 

/*  Abstract  syntax */ 

term  :   Static(exp) 
I   Dynamic (exp) 

list  expList; 

expList  :   ExpListPair(term  expList) 
I   ExpListNilQ 


/*  Minimal  parenthesization  */ 

term  :   Static,  Dynamic  {  exp. precedence  =  0;  } 
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/*  Unparsing */ 

expList  :  ExpListPair   [  ©  :  ~    ['7.S (PUNCTUATION :  ;°/.S)y„n°/„n'*]  @  ] 


/*  Concrete  input  syntax  */ 

ExpList  {  synthesized  expList  abs;  }; 
expList  ~  ExpList. abs; 

ExpList  : :=   (Exp)  {  ExpList. abs  =  Static(Exp.abs)  ::  ExpListNilO ;  } 
I    (Exp  ;;'  ExpList)  {ExpList$l .abs  = 

Static (Exp. abs)  ::  ExpList$2.abs ;  } 


*  File  Name  :  id.ssl  * 

*  Purpose    :  Defines  identifiers  of  the  language  * 

/*  Abstract  syntax  and  unparsing  */ 

Id  :   IdNullQ    [  *  ::=  '7,S (PLACEHOLDER :  <ident if  ier>°/,S)"  ] 
I   Identifier  (ID)    [  *"  :  :=  **  ] 


/*  Concrete  input  syntax  */ 

id  {  synthesized  Id  abs;  }; 
Id  ~  id. abs; 

id    ::=  (ID)    {  id. abs  =  Identif ier(ID) ;  } 
I    (IDENTIFIER.PLACEHOLDER) 
{  id. abs  =  IdNull;  } 


/*  Attribution */ 

Id  {synthesized  ID  name; 

synthesized  BOOL  partial; 

}; 

Id  :   IdNull      { 
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Id. name  =  ".undeclared"; 
Id. partial  =  true; 
} 
I    Identifier   { 
Id. name  =  ID; 
Id. partial  =  false; 
} 


*  File  Name  :  if .ssl  * 

*  Purpose    :  Defines  the  if-then-else  construct  * 

/*  Abstract  syntax */ 

exp  :   Cond(exp  exp  exp); 

/*  Minimal  parenthesization  */ 

exp  :   Cond  { 

exp$2. precedence  =  0 

exp$3. precedence  =  0 

exp$4. precedence  =  0 
} 


/*  Unparsing */ 

exp  :   Cond 

C"  ::=  '7.t0/0{°/,S  (KEYWORD:  if  °/.S)  "  @  "  0/.c°/„S  (KEYWORD  :then%S)  "  0 
"  y.c'/.S (KEYWORD :else°/.S)  "  <9  "  ,/.b,/.c,/.S (KEYWORD  :f  i'/.S)0/,}"] 


/*  Template  commands  */ 

transform  exp 

on  "if"  <exp>:  Cond(<exp>,  <exp>,  <exp>) , 

on  "if"  e  when  (e  !=  <exp>)  :  Cond(<exp>,  e,  <exp>) 


/*  Concrete  input  syntax  */ 

Exp  : :=   (IF  Exp  THEN  Exp  ELSE  Exp  FI) 

{  ExpSl.abs  =  Cond(Exp$2.abs,  Exp$3.abs,  Exp$4.abs);  } 
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*  File  Name  :  if_infer.ssl  * 

*  Purpose    :  Type  inference  for  if-then-else  construct  * 

exp  :   Cond  { 

exp$2.typeEnv  =  exp$l .typeEnv; 

exp$2.1etvars  =  exp$l .letvars; 

exp$3 . letvars  =  exp$l .letvars; 

exp$4. letvars  =  exp$l .letvars; 

exp$2.s  =  exp$l.s; 

exp$3.s  =  Unify (exp$2.typeAssignment ,  IntType,  exp$2.S); 

exp$3. typeEnv  =  ApplySubstToTypeEnv(exp$3. s,  exp$l .typeEnv) ; 

exp$4.s  =  exp$3.S; 

exp$4. typeEnv  =  ApplySubstToTypeEnv(exp$3.S,  exp$l .typeEnv) ; 

exp$l.S  =  Unify (exp$3 .typeAssignment ,  exp$4.typeAssignment , 

exp$4.S)  ; 
exp$l .typeAssignment  =  exp$3. typeAssignment ; 
exp$l .partial  =  exp$2 .partial  II  exp$3. partial  I  I 

exp$4. partial; 
exp$4.sv  =  exp$l.sv; 
exp$3.sv  =  exp$l.sv; 
exp$2.sv  =  exp$l.sv; 
exp$4 . encl  =  exp$ 1 . encl ; 
exp$3 . encl  =  exp$ 1 . encl ; 
exp$2 . encl  =  exp$ 1 . encl ; 
exp$2.top  =  false; 
exp$3.top  =  false; 
exp$4.top  =  false; 


exp  :   Cond  {in  TypeErrors  on  (exp$l.S  ==  FailSubst  && 

exp$2.S  !=  FailSubst  &&  exp$3.S  !=  FailSubst  && 

exp$4.S  !=  FailSubst);  }  [  TypeErrors  @  :  "If'/.n" ] 


Z***********************************^ 
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*  File  Name  :  infer. ssl  * 

*  Purpose    :  Implementation  of  the  type  inference  for  * 

*  Poly  C.  This  implementation  is  based  on  * 

*  Dennis  Volpano ' s  implementation  for  core  ML  with  * 

*  letvar  and  first-class  refs.  * 

STR  foreign  newsymi();  /*  generate  symbols  *1,  *2,  *3  ....  */ 

/*  Poly  C  has  only  weak  type  variables.*/ 
TYPEVAR  :  WeakVar  (STR)         [©  :  0  ] 


/*  We  need  this  phylum  to  type  the  functions  of  Poly  C  */ 

list  TYPEEXPLIST; 

TYPEEXPLIST  :  TypeExpListNilO  [©:] 

I  TypeExpListPair(TYPEEXP  TYPEEXPLIST) 

[  0  :  "  ['7.S (OPERATOR:  \<times>  c/,S)°/.o"]  0  ] 


TYPEEXP  :  NullTypeO         [0  :  "?"  ] 

I  UniversalType()      [0  :  "\<bottom>"  ] 

I  IntType   ()         [0  :  "int"  ] 

I  RealType   ()         [0  :  "real"  ] 

I  UnitType  ()         [0  :  "unit"  ] 

I  TypeVar  (TYPEVAR)      [0:0] 

I  MapType   (TYPEEXPLIST  TYPEEXP)  [©  :  "("  0  "%S(0PERAT0R: 

\<rightarrow>  0/.S)'/.o"  ©  ")"  ] 

I  PairType  (TYPEEXP  TYPEEXP)    [0  :  "("  0  "  \<times>  "  0  ")"  ] 

I  RefType   (TYPEEXP)      [0:0"  ptr"  ] 


TYPESCHEME 

:  TypeExp  (TYPEEXP)         [0  :  0] 

I  TypeVarBinding  (TYPEVAR  TYPESCHEME)    [©  :  "\<forall>"  0  "."  0] 


TYPEEXP  TypeExpOfTypeScheme (TYPESCHEME  t)  { 
with(t)  ( 

TypeExp (e) :  e, 

TypeVarBinding(i,  s) :  TypeExpOfTypeScheme (s) , 

) 
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>; 

/*  Substitutions  :  Finite  functions  mapping  type  variables  to  types 

*   Empty  substitution  is  denoted  by  IdSubst 

*/ 

SUBST    :  FailSubstO       [0  :  "FailSubst"] 
I  IdSubst ()  [0  :  ] 

I  SubstConcat(TYPEVAR  TYPEEXP  SUBST) 
[0  :  ",/,{<"  <9  ":"  @  ">,/.o"  0  "%}"  ] 


BOOL  InSubst (TYPEVAR  tyvar,  SUBST  s)  { 
with(s)  ( 

FailSubst:  false, 
IdSubst:  false, 

SubstConcat (j ,  *,  sub):  j  ==  tyvar  ?  true  :  InSubst (tyvar ,  sub), 
) 

}; 

TYPEEXP  LookupInSubst (TYPEVAR  tyvar,  SUBST  s)  { 
with(s)  ( 

FailSubst:  NullType, 

IdSubst:  UniversalType, 

SubstConcat (j ,  t,  sub):  j  ==  tyvar  ?  t  : 

LookupInSubst (tyvar ,  sub), 
default  :  tyvar 
) 

}; 

TYPEEXP  Ult  (TYPEEXP  t,  SUBST  s)  {   /*  close  substitution  s  for  t  */ 
with  (t)  ( 

TypeVar(v)  :  InSubst (v,  s)  ? 

Ult (LookupInSubst (v,  s) ,  s)  :  t, 
default  :  t 
) 

h 

TYPEEXP  RecRealAux (TYPEEXP  t,  SUBST  s)  { 
with  (t)  ( 

TypeVar(v)  :  let  e  =  LookupInSubst (v,  s)  in  ( 
with(e)  ( 
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NullType:  t, 
UniversalType:  t, 
default:  RecRealAux(e,  s) 
) 

). 

MapType(u,  w) :  MapType(RecRealListAux(u,  s)  ,  RecRealAux(w,  s)), 
PairType(u,  w) :  PairType(RecRealAux(u,  s) ,  RecRealAux(w ,  s)), 
RefType(u) :  Ref Type(RecRealAux(u,  s)), 
default :  t 
) 


>; 


TYPEEXPLIST  RecRealListAux(TYPEEXPLIST  1,  SUBST  s)  { 
with(l)  ( 

TypeExpListPair(v,  1)  :  RecRealAux(v,  s)  ::  RecRealListAux(l,  s) , 
default  :  1 
) 

>; 

TYPEEXP  RecReaKTYPEEXP  t,  SUBST  s)  { 
with(s)  ( 

FailSubst :  NullType, 

IdSubst:  t, 

default:  RecRealAux(t ,  s) , 

) 
>; 

SUBST  RemoveFromSubst (SUBST  s,  TYPEVAR  id)  { 
with  (s)  ( 

FailSubst:  FailSubst, 
IdSubst:  IdSubst, 
SubstConcat (i,  t,  sub): 

i  ==  id  ?  sub  :  SubstConcat (i,  t,  RemoveFromSubst (sub,  id)), 
) 

}; 

TYPEEXP  ApplySubstToTypeVar (SUBST  s,  TYPEVAR  v)  { 
with  (s)  ( 

FailSubst:  NullType, 

default:  let  t  =  LookupInSubst (v,  s)  in  ( 
with  (t)  ( 

UniversalType:  TypeVar(v) , 
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default:  ApplySubstToTypeExp(s,  t) 
) 
)) 
}; 

TYPEEXP  Apply SubstToTypeExp (SUBST  s,  TYPEEXP  t)  { 
with(s)  ( 

FailSubst:  NullType, 
IdSubst:  t, 
default : 
with(t)  ( 

TypeVar(u):  ApplySubstToTypeVar(s,  u) , 

MapType(tl,  t2) :  MapType(ApplySubstToTypeExpList (s,  tl), 

ApplySubstToTypeExp(s,  t2)), 
PairType(tl,  t2) :  PairType(ApplySubstToTypeExp(s,  tl) , 

ApplySubstToTypeExp(s,  t2)), 
RefType(t):  RefType(ApplySubstToTypeExp(s ,  t)), 
default :  t 
) 
) 

>; 


TYPEEXPLIST  ApplySubstToTypeExpList (SUBST  s,  TYPEEXPLIST  t)  { 
with(t)  ( 

TypeExpListPair(v,  1):  ApplySubstToTypeExp(s,  v) : : 

ApplySubstToTypeExpList (s,  1), 
default  :  t 
) 

}; 


TYPESCHEME  ApplySubstToTypeScheme (SUBST  s,  TYPESCHEME  t)  { 
with(t)  ( 

TypeExp(e):  TypeExp(ApplySubstToTypeExp(s ,  e)), 
TypeVarBinding(i ,  u) : 

TypeVarBinding(i,  ApplySubstToTypeScheme (RemoveFromSubst ( 
s,  i) ,  u)) , 
) 

}; 


70 


*  let/letarr/letvar-bound  identifier  list       * 

list  LVLIST; 

LVLIST  :  LVNilO  [®  :  ] 

I  LVCons(Id  LVLIST)      [0  :  <§  [",  "]  <S  ] 


LVLIST  RemoveFromLVList  (Id  id,  LVLIST  1)  { 
with  (1)  ( 
LVNil  :  1, 
LVCons(v  as  IdNullO,  rest)  : 

v  ::  RemoveFromLVList (id,  rest), 
LVCons(v,  rest)  :  (v  ==  id)  ?  rest  : 
v  ::  RemoveFromLVList (id,  rest) 
) 

}; 

BOOL  InLVList  (Id  id,  LVLIST  1)  { 
with(l)  ( 

LVNil  :  false, 

LVCons(v,  rest)  :  (v  ==  id)  ?  true  :  InLVList(id,  rest), 

) 

}; 


*  variable/identifier  list  * 

list  VLIST; 

VLIST  :   BVNilO  [0  :  ] 

I  BVCons(Id  VLIST)      [fi  :  0  [",  "]  @  ] 


BOOL  InVList  (Id  id,  VLIST  1)  { 
with(l)  ( 

BVNil  :  false, 

BVCons(v,  rest)  :  (v  ==  id)  ?  true  :  InVList (id,  rest), 

) 

}; 
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*  static  (top  level)  variable/identifier  list   * 

*  These  identifiers  are  the  ones  whose         * 

*  declaration  satisfies  the  conditions  to  become* 

*  top  level  as  explained  in  Chapter  I.  * 

list  SVLIST; 

SVLIST  :  SVNilO  [<§  :  ] 

I  SVCons(Id  SVLIST)      [<§  :  @  [",  "]  ®  ] 


*  Type  environments  * 

TYPEEMV    :  NullTypeEnvO  [<B  :  ] 

I  TypeEnvConcat (ID  TYPESCHEME  TYPEENV) 

[0  :  "°/,{["  ®  ":"  @  "]°/,o"  0  "•/.}"  ] 


/* 

*  RemoveFromTypeEnv 
* 

*  Remove  entry  for  id  from  s. 

*  Note:  we  assume  s  contains  only  one  entry  for  id. 

*/ 

TYPEENV  RemoveFromTypeEnv (ID  id,  TYPEENV  s)  { 
with(s)  ( 

NullTypeEnv:  s, 
TypeEnvConcat (i ,  t,  tail): 
id  ==  i  ?  tail 

:  TypeEnvConcat (i,  t,  RemoveFromTypeEnv (id,  tail)) 
) 

}; 

TYPESCHEME  LookupInTypeEnv(ID  id,  TYPEENV  s)  { 
with(s)  ( 

NullTypeEnv:  TypeExp(UniversalType) , 

TypeEnvConcat (i,  t,  tail):  id  ==  i  ?  t  :  LookupInTypeEnv(id, 
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tail) , 


}; 


TYPEENV  ApplySubstToTypeEnv(SUBST  s,  TYPEENV  e)  { 
with(s)  ( 

IdSubst :  e, 
FailSubst :  e, 
default : 

with(e)  ( 

NullTypeEnv :  NullTypeEnv , 
TypeEnvConcat (i,  t,  tail): 

TypeEnvConcat (i ,  ApplySubstToTypeScheme(s,  t) , 
ApplySubstToTypeEnv(s ,  tail)), 
) 
) 

}; 


*   Generate  a  generic  instance  * 


/*  list  of  type  variables  */ 
list  TVLIST; 
TVLIST  :   TVNilO 

I   TVCons (TYPEVAR  TVLIST) 


] 

0  [' 


']  <D  ] 


/*  return  all  type  vars  in  type  exp  t  */ 
TVLIST  Tvarsln  (TYPEEXP  t,  TVLIST  1)  { 
with  (t)  ( 

TypeVar(v) 

MapType(tl,t2) 

PairType(tl,t2) 

RefType(t) 

default 

) 

}; 


v  ::  1, 

TvarsIn(t2,TvarsInList (tl,l)) , 
Tvarsln(t2, Tvarsln (tl,l)) , 
Tvarsln(t ,  1) , 
1 


TVLIST  TvarsInList  (TYPEEXPLIST  t,  TVLIST  1)  { 
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with(t)  ( 

TypeExpListPair(v,  rest)  :  TvarsInList (rest ,  Tvarsln(v,  1)), 

default  :  1 
) 


>; 


/*  is  type  var  x  in  type  var  list?  */ 
BOOL  InTVList  (TYPEVAR  x,  TVLIST  1)  { 
with(l)  ( 

TVNil  :  false, 

TVCons(v,  rest)  :  (v  ==  x)  ?  true  :  InTVList (x,  rest) 
) 

>; 


/*  all  x  members  not  in  y  */ 
TVLIST  Bar  (TVLIST  x,  TVLIST  y)  { 
with  (x)  ( 

TVNil  :  TVNil, 

TVCons(v,rest)  :  InTVList (v,  y)  ?  Bar (rest, y) 
:  TVCons(v,  Bar (rest,  y)) 
) 

}; 


/*  free  type  vars  in  scheme  */ 

TVLIST  FreeScheme  (TYPESCHEME  s,  TVLIST  scvs)  { 
with  (s)  ( 

TypeExp(t)  :  Bar(  Tvarsln(t , TVNil) ,  scvs), 

TypeVarBinding(v,  rest)  :  FreeScheme (rest ,  TVCons(v,scvs) )  , 
) 

>; 


/*  free  type  vars  in  type  environment  */ 
TVLIST  FreeTe  (TYPEENV  te)  { 
with(te)  ( 

NullTypeEnv:  TVNil, 

TypeEnvConcat (i,t ,tail) :  FreeScheme (t, TVNil)  @  FreeTe(tail) , 


) 


}; 
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/*  return  a  list  of  noduplicates  */ 
TVLIST  Nodups  (TVLIST  1,  TVLIST  ace)  { 
with(l)  ( 

TVNil:  ace, 
TVCons(v,  tail)  : 

InTVList (v,acc)  ?  Nodups (tail,  ace) 

:  Nodups (tail,  TVCons(v,acc)) , 
) 

>; 


TYPESCHEME  MkScheme (TVLIST  vs,  TYPEEXP  t)  { 
with(vs)  ( 

TVNil:  TypeExp(t), 
TVCons(v,  tail) : 

TypeVarBinding(v,  MkScheme(tail,t)) , 
) 

>; 


/*  normal  closure  */ 

TYPESCHEME  Close (TYPEENV  a,  TYPEEXP  t)  { 

MkScheme(Bar(Nodups(TvarsIn(t, TVNil), TVNil),  FreeTe(a)),  t) 

>; 


/*  instantiate  a  scheme  */ 

TYPEEXP  InstSchemeAux  (TYPESCHEME  ts,  SUBST  s)  { 
with(ts)  ( 

TypeExp(t)  :  ApplySubstToTypeExp(s,  t) , 
TypeVarBinding(v,  rest)  : 

Inst SchemeAux (rest ,  SubstConcat (v , 
TypeVar(WeakVar(newsymi())) ,  s)) 
) 
}; 


TYPEEXP  Inst Scheme (TYPESCHEME  s)  { 
InstSchemeAux (s,  IdSubst) 
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}; 


*  Unification  of  type  expressions  * 

SUBST  Unify(TYPEEXP  t,  TYPEEXP  u,  SUBST  s)  { 

s  ==  FailSubst  ?  FailSubst  :  Equate (Ult(t,  s) ,  Ult(u,  s) ,  s) 

}; 


/*  unifies  lefthand  side  of  a  function  space  operator  */ 
SUBST  UnifyList(TYPEEXPLIST  t,  TYPEEXPLIST  u,  SUBST  s)  { 
(s  ==  FailSubst)  ?  FailSubst  : 
with  (t)  ( 

TypeExpListPair(vl,  restl)  : 
with(u)  ( 
TypeExpListPair(v2,  TypeExpListNilO)  : 
Equate (Ult(vl,  s) ,  Ult(v2,  s) ,  s) , 
TypeExpListPair(v2,  rest2)  : 
UnifyList (restl,  rest2,  Equate (Ult(vl,  s) ,  Ult(v2,  s) ,  s)), 
default  :  s 

), 

default  :  s 

) 

}; 


/*  returns  length  of  a  list  */ 
INT  Length (TYPEEXPLIST  1)  { 
with(l)  ( 

TypeExpListPair(v,  rest)  :  1  +  Length(rest) , 
default  :  0 
) 

}; 


SUBST  Equate (TYPEEXP  t,  TYPEEXP  u,  SUBST  s)  { 
t  ==  u  ?  s  : 
with  (t)  ( 
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}; 


UniversalTypeO  :  s, 
TypeVar(v)  : 
with(u)  ( 

UniversalTypeO:  s, 

default:  TypeVarOccurCheck(v,  u,  s)  ?  FailSubst  : 
SubstConcat(v,  u,  s) , 

), 

RefType(tl) : 
with(u)  ( 

UniversalTypeO:  s, 
TypeVar(ul) :  Equate(u,  t,  s) , 
RefType(ul):  Unify (tl,  ul,  s) , 
default:  FailSubst, 

). 

MapType(tl,  t2) : 

with(u)  ( 

UniversalTypeO:  s, 

TypeVar(ul) :  Equate(u,  t,  s) , 

MapType(ul,  u2) :  (Length(tl)  ==  Length (ul))  ? 

Unify (t2,  u2,  UnifyList (tl ,  ul,  s))  :  FailSubst, 
default:  FailSubst, 

), 

PairType(tl,  t2) : 
with(u)  ( 

UniversalTypeO:  s, 

TypeVar(ul) :  Equate(u,  t,  s) , 

PairType(ul,  u2) :  Unify (t2,  u2,  Unify (tl,  ul ,  s)), 

default :  FailSubst , 

), 

default : 

with(u)  ( 

UniversalTypeO:  s, 

TypeVar(ul) :  SubstConcat (ul ,  t,  s) , 

default:  FailSubst, 

), 
) 


BOOL  TypeVarOccurCheck(TYPEVAR  v,  TYPEEXP  t,  SUBST  sub)  { 
with(t)  ( 

UniversalTypeO:  false, 
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TypeVar(u):  (u  ==  v)  I  I  (InSubst(u,  sub)  && 

TypeVarOccurCheck (v,  LookupInSubst (u,  sub),  sub)), 
MapType(tl,  t2)  :  TypeVarOccurCheckList (v,  tl,  sub)  I  I 

TypeVarOccurCheck(v,  t2,  sub), 
PairType(tl,  t2) :  TypeVarOccurCheck(v,  tl,  sub)  II 

TypeVarOccurCheck(v,  t2,  sub), 
RefType(tl) :  TypeVarOccurCheck(v,  tl,  sub), 
default :  false 
) 


}; 


/*  implement  TypeVarOccurCheck  for  a  list  of  type  expressions  */ 
BOOL  TypeVarOccurCheckList (TYPEVAR  v,  TYPEEXPLIST  t,  SUBST  sub)  { 
with(t)  ( 

TypeExpListPair(u,  rest)  : 

TypeVarOccurCheck (v,  u,  sub)  ?  true 

: TypeVarOccurCheckList (v,  rest,  sub), 


default  :  false 


}; 


/*  Is  e  a  value  of  Poly  C  ?  */ 
BOOL  NonExpansive  (exp  e)  { 
with(e)  ( 


Pair(s,  t) 
Ident(*) 
Lambda(*,  *) 
default 
) 


NonExpansive (s)  &&  NonExpansive (t) , 

true, 

true, 

false 


}; 


/*  Initial  type  environment  is  empty  */ 
TYPEENV  InitialEnvironmentO  {  NullTypeEnv  }; 


*  File  Name  :  int.ssl  * 

*  Purpose    :  Integer  operators  * 
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/*  Abstract  syntax */ 

exp  :    IntOp(INT) 

I    Sum,  Diff,  Prod,  Quot (exp  exp) 
I    LessThan,  LessThanOrEqual ,  Great erThan, 
Great erThanOrEqual (exp  exp) 


/*  Minimal  parenthesization  */ 

exp  :    Sum,  Diff  PP2(6) 

I    Prod,  Quot  PP2(7) 

I    LessThan,  LessThanOrEqual,  GreaterThan,  GreaterThanOrEqual 
PP2(5) 


/*  Unparsing */ 

exp  :    IntOp      [    : :=  "  ] 

I    Sum   [  *  ::=  '7„{'/,S (PUNCTUATION :  "  lp  "'/,S)"  <9  "  °/.S( OPERATOR :+°/0S) 

to   "  <9  "XS (PUNCTUATION:"  rp  "XS)X}"  ] 
I    Diff  [  *  ::=  '7.{'/.S  (PUNCTUATION :  "  lp  »%S)"  0  "  °/.S  (OPERATOR:  -°/„S) 

°/.o  "  <9  "XS (PUNCTUATION:"  rp  '7,S)X}"  ] 
I    Prod  [  "  ::=  "X{XS (PUNCTUATION : "  lp  "XS)"  0  "  °/„S  (OPERATOR:  *°/.S) 

7„o  "  <2  '  7,  S  (PUNCTUATION:"  rp  '7,S)X}"  ] 
I    Quot  [  "  ::=  "X{XS  (PUNCTUATION :  "  lp  ,,0/.S)"  @  "  °/,S  (OPERATOR: /°/,S) 

°/,o  "  ©  " */. S (PUNCTUATION:"  rp  '7,S)°/,}"  ] 
I    LessThan   [  "    :  :=  "'/.{'/.S  (PUNCTUATION :  "  lp  ,,0/„S)"  0  " 

P/,S  (OPERATOR:  <°/,S),/.o  "  0  "'/.S (PUNCTUATION :"  rp  "°/.S)0/c}"] 
I    LessThanOrEqual  [  ~  :  :=  "%{%S (PUNCTUATION : "  lp  ,,0/S)"  0  "  °/.S( 

OPERATOR :%<le>XS)Xo  "  <9  "7.S (PUNCTUATION :  "  rp  M,/,S)0/o}"] 
I    GreaterThan   [  "  :  :=  '"/.{XS (PUNCTUATION:"  lp  "XS)M  0  "  XS( 

OPERATOR :>XS)Xo  "  8  "XS (PUNCTUATION :  "  rp  l,0/.S)0/.}"] 
I    GreaterThanOrEqual   [  "  :  :=  "X{XS (PUNCTUATION :  "  lp  "°/,S)"  0  " 

XS (OPERATOR :X<ge>XS)Xo  "  ®  "XS (PUNCTUATION : "  rp  "XS)X}"] 


/*  Template  commands  */ 

transform  exp 


on  "+"  <exp> 

on  "-"  <exp> 

on  "*"  <exp> 

on  "/"  <exp> 


Sum(<exp>,  <exp>) , 
Diff(<exp>,  <exp>)  , 
Prod(<exp>,  <exp>)  , 
Quot(<exp>,  <exp>) , 
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on  "<"  <exp>  :  LessThan(<exp>,  <exp>) , 

on  "<="  <exp>  :  LessThanOrEqual(<exp>,  <exp>) , 

on  ">"  <exp>  :  GreaterThan(<exp>,  <exp>)  , 

<exp>  :  GreaterThanOrEqual(<exp>,  <exp>) 


/*  Concrete  input  syntax  */ 


Exp 


(INTEGER)  {  Exp$l.abs  =  IntOp (STRtoINT( INTEGER) ) ;  } 
(Exp  '+'  Exp)  {  Exp$l.abs  =  Sum(  Exp$2.abs,  Exp$3.abs);  } 
(Exp  '-'  Exp)  {  Exp$l.abs  =  Diff (Exp$2 .abs,  Exp$3.abs);  } 
(Exp  '*'  Exp)  {  Exp$l.abs  =  Prod(Exp$2 .abs,  Exp$3.abs);  } 
(Exp  '/'  Exp)  {  Exp$l.abs  =  Quot (Exp$2.abs,  Exp$3.abs);  } 
(Exp  '<'  Exp)  {  Exp$l.abs  =  LessThan(Exp$2.abs ,  Exp$3.abs);  } 
(Exp  LESSEQUAL  Exp  prec  LESSEQUAL) 

{  Exp$l.abs  =  LessThan0rEqual(Exp$2 .abs,  Exp$3.abs);  } 
(Exp  '>'    Exp)  {Exp$l.abs  =  GreaterThan(Exp$2.abs,  Exp$3.abs);  } 
(Exp  GREATEREQUAL  Exp  prec  GREATEREQUAL) 

{  Exp$l.abs  =  GreaterThan0rEqual(Exp$2.abs,  Exp$3.abs);  } 


*  File  Name  :  int_inf er . ssl  * 

*  Purpose    :  Type  inference  for  integer  operators  * 

exp  :    IntOp  { 

exp.typeAssignment  =  IntType; 
exp . S  =  exp . s ; 
exp. partial  =  false; 
} 
I    Sum,  Diff,  Prod,  Quot  { 

exp$2.typeEnv  =  exp$l .typeEnv; 

exp$2 . let vars  =  exp$ 1 . let var s ; 

exp$3.1etvars  =  exp$l .let vars; 

exp$2 . s  =  exp$l.s; 

exp$3 . s  =  Unify (exp$2. typeAssignment ,  IntType,  exp$2.S); 

exp$3 .typeEnv  =  ApplySubstToTypeEnv(exp$3 . s, 

exp$l .typeEnv) ; 
exp$l.S  =  Unify (exp$3. typeAssignment ,  IntType,  exp$3.S); 
exp$l .typeAssignment  =  IntType; 
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exp$l .partial  =  exp$2. partial  I  I  exp$3. partial; 

exp$3 . sv  =  exp$l.sv; 

exp$2 . sv  =  exp$l.sv; 

exp$3 . encl  =  exp$ 1 . encl ; 

exp$2.encl  =  exp$l.encl; 

exp$2.top  =  false; 

exp$3.top  =  exp$l.top; 
} 
LessThan,  LessThanOrEqual,  Great erThan,  GreaterThanOrEqual  { 

exp$2 .typeEnv  =  exp$l .typeEnv; 

exp$2 . letvars  =  exp$l .letvars; 

exp$3 .letvars  =  exp$l . letvars ; 

exp$2 . s  =  exp$l . s ; 

exp$3.s  =  Unify (exp$2. typeAssignment ,  IntType,  exp$2.S); 

exp$3. typeEnv  =  ApplySubstToTypeEnv(exp$3 . s,exp$l .typeEnv) ; 

exp$l.S  =  Unify(exp$3. typeAssignment ,  IntType,  exp$3.S); 

exp$l .typeAssignment  =  IntType; 

exp$l .partial  =  exp$2 .partial  I  I  exp$3. partial; 

exp$3 . sv  =  exp$l.sv; 

exp$2.sv  =  exp$l.sv; 

exp$3.encl  =  exp$l .encl; 

exp$2 . encl  =  exp$ 1 . encl ; 

exp$2.top  =  false; 

exp$3.top  =  exp$l.top; 


exp  :    Sum,  Diff ,  Prod,  Quot  {  in  TypeErrors  on  (exp$l.S  ==  FailSubst 

&&  exp$2.S  !=  FailSubst  &&  exp$3.S  !=  FailSubst) ; 
} 
I    Sum    [  TypeErrors  @  :  "Sum°/.n"  "  "  ] 


I  Diff  [  TypeErrors  0 
I  Prod  [  TypeErrors  @ 
I    Quot    [  TypeErrors  @ 


"Diff0/,n"  "  "  ] 
"Prod'/.n"  *  "  ] 
"Quot'/.n"  "  "  ] 

LessThan,  LessThanOrEqual,  Great erThan,  GreaterThanOrEqual 
in  TypeErrors  on  (exp$l.S  ==  FailSubst  &&  exp$2.S  != 

FailSubst  &&  exp$3.S  !=  FailSubst); 
} 
I    LessThan        [  TypeErrors  @  :  "LessThan'/on"     ] 
I    LessThanOrEqual     [  TypeErrors  @  :  "LessThanOrEqual'/on" 
I    GreaterThan         [  TypeErrors  @  :  "GreaterThanc/0n"     ] 
I    GreaterThanOrEqual 
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[  TypeErrors  @  :  "GreaterThanOrEqual°/,n"  "    "   ] 


*  File  Name  :  lambda. ssl  * 

*  Purpose    :  * 

/*  An  address  is  a  pair  of  a  segment  and  an  offset.  */ 

#  define  SEGMENT  STR 

#  define  OFFSET  STR 

/*  Formal  parameters  of  a  function  is  a  list  of  identifiers.  */ 

/*  Abstract  syntax */ 

list  f ormalParamList ; 

f ormalParamList  :    FormalParamListNilO 

FormalParamListPair(Id  f ormalParamList) 


FormalParamList  {  synthesized  f ormalParamList  abs;  }; 

/*  Actual  parameters  of  an  application  is  a  list  of  expressions.  */ 
/*  Abstract  syntax */ 

list  actualParamList ; 

actualParamList    :    ActualParamListNilO 

I    ActualParamListPair(exp  actualParamList) 

ActualParamList  {  synthesized  actualParamList  abs;  }; 

/* */ 


/*  Abstract  syntax */ 

exp    :    VoidExpO 

I    Refloc,  Varloc (LOCATION) 

I    I dent (Id) 

I    Lambda (f ormalParamList  exp) 

I    Call (exp  actualParamList) 
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LOCATION  :    NullLocQ       [@  :  ] 

I    Loc(SEGMENT  OFFSET)    [  "  :  "®("~"  ,  "*")  "  ] 


/*  Minimal  parenthesization  */ 

exp  {  inherited  INT  precedence;  }; 

#  define  PPl(n)  {\ 

local  STR  lp;\ 

local  STR  rp;\ 

exp$2 .precedence  =  (n);\ 

lp  =  ($$. precedence  >  (n))  ?  "("  :  ""  ;\ 

rp  =  ($$. precedence  >  (n) )  ?  ")"  :  ""A 

} 

#  define  PP2(n)  {\ 

local  STR  lp;\ 

local  STR  rp;\ 

exp$2. precedence  =  (n);\ 

exp$3. precedence  =  (n)+l;\ 

lp  =  ($$. precedence  >  (n))  ?  "("  :  "";\ 

rp  =  ($$. precedence  >  (n))  ?  »)"  :  ""  ;\ 

} 

/* 

*  Values  are  a  subset  of  the  expressions,  so  SSL  expects  values  to 

*  to  be  attributed  as  well  since  expressions  are  attributed.  But  the 

*  attribution  is  not  important  so  we  define  two  macros  to  silence  SSL 
*/ 

#  define  SYNSILENCE(P)  P .typeAssignment  =  NullType;\ 

P.S  =  IdSubst();\ 
P. partial  =  false; 

#  define  INHSILENCE(P)  P.typeEnv  =  NullTypeEnv ; \ 

P.letvars  =  LVNilQ  ;\ 
P.s  =  IdSubst();\ 
P. precedence  =  0;\ 
P.sv  =  SVNil();\ 
P.encl  =  true;\ 
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P. top  =  false; 


exp    :    Call   PP1(0) 
I    Lambda  PP1(0) 


/*  Unparsing  

exp  :   VoidExp    [**::-  "°/.S (PLACEHOLDER :<exp>°/.S)"  ] 
I   Ident      [  "    : :-  ~  ] 
I    Refloc     [  *  :  "~"~   ] 
I   Varloc     [  ~  :  "   ] 
I    Call       [  **  ::=  0  '"/.{•/.S (PUNCTUATION :  (0/„S)0/Oo,,  0 

"%S  (PUNCTUATION  :)°/.S  )•/.}"] 
I    Lambda 

[~  ::=  '"/.{'/.S (PUNCTUATION:"  lp  "°/,S),/„S (PUNCTUATION: 
y,<lambda>(%S)"  0  "°/,S (PUNCTUATION :),/„S)°/„S (PUNCTUATION 
{•/.SV/.L"  0  "°/,S (PUNCTUATION:  }  7.S)'/.S (PUNCTUATION: 
"  rp  "%S)"   M,/.b0/,}"] 


*/ 


/*  Template  rules  

transform  exp 

on  "fun"       e:  Lambda(<f ormalParamList> ,  e) , 

on  "call"    <exp>  :  Call(<exp>,  <actualParamList>) , 

on  "call"  e    :  Call(e,  <actualParamList>) 


*/ 


/*  Concrete  input  syntax  

Exp  {  synthesized  exp  abs;  }; 

exp  ~  Exp . abs ; 

Exp  ::=   (EXP.PLACEHOLDER)  {  Exp. abs  =  VoidExp;  } 

I    (id)    {  Exp. abs  =  Ident (id. abs) ;  } 

I    (LAMBDA  '('  FormalParamList  ')'    '{'    Exp  '}') 

{  Exp$l.abs  =  Lambda (FormalParamList .abs,  Exp$2.abs);  } 

I    ('('Exp')O 

{  Exp$l.abs  =  Exp$2.abs  ;  } 

I    (Exp  '('  ActualParamList  »)'  ) 


*/ 


84 


{  Exp$l.abs  =  Call(Exp$2 .abs,  ActualParamList .abs) ;  } 


/*  Unparsing */ 

f ormalParamList  :   FormalParamListNil    [@:] 

I   FormalParamListPair   [  0  :  '"/,{"  "  [,,0/„S  (PUNCTUATION 

,y.s)  y.o"  ]  c  "7.}"] 


/*  Concrete  input  syntax  */ 

f ormalParamList  ~  FormalParamList .abs; 
FormalParamList  ::=    (id)    {  FormalParamList . abs  = 

(id. abs  ::  FormalParamListNil);  } 
I    (id  ','    FormalParamList)  {  FormalParamList$l .abs  = 

(id. abs  ::  FormalParamList $2 . abs) ;  } 


/*  Unparsing */ 

actualParamList  :   ActualParamListNil  [@:] 

I    ActualParamListPair  [  0  :  "  ['7.S  (PUNCTUATION :  //.S) 

Xo"  ]  @] 


/*  Concrete  input  syntax  */ 

actualParamList  ~  ActualParamList .abs; 

ActualParamList  ::=   (Exp)    {  ActualParamList . abs  =  Exp. abs  :: 

ActualParamListNil () ;  } 
I   (Exp  ' ,;  ActualParamList)  {  ActualParamList$l .abs  = 

Exp. abs  ::  ActualParamList$2 . abs ;  } 


*  File  Name  :  lambda_inf er. ssl  * 

*  Purpose    :  * 

/*  Common  attributes  of  exp  and  actualParamList . 

*  Attibutes  encl,  top  and  sv  are  used  in  checking  if 

*  the  free  identifiers  of  a  lambda  abstraction  are  top  level, 
encl  shows  if  an  expression  is  enclosed  by  a  lambda  abstraction; 
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top  shows  if  an  expression  occurs  in  a  top  level  scope.  For 
instance  in  letvar  x  =  e_l  in  e_2,  e_l.top  is  always  false. 
If  this  letvar  expression  is  enclosed  by  an  expression  e  then 
e_2.top  gets  the  same  value  as  the  value  of  e.top.  Otherwise, 
e_2.top  is  true;  sv  is  a  list  of  top  level  identifiers. 
*/ 

exp,  actualParamList  { 

inherited  TYPEENV  typeEnv; 
inherited  LVLIST  letvars; 
synthesized  BOOL  partial; 
synthesized  SUBST  S; 
inherited  SUBST  s; 
inherited  BOOL  encl; 
inherited  BOOL  top; 
inherited  SVLIST  sv; 

>; 

/*  Types  of  expressions  of  an  actualParamList  are  hold  in 

*  texlist.  texlist  is  a  TYPEEXPLIST  which  is  implemented 

*  using  SSL  list. 
*/ 

actualParamList  {  synthesized  TYPEEXPLIST  texlist;  }; 
exp  {  synthesized  TYPEEXP  typeAssignment ;  }; 

actualParamList  :   ActualParamListPair  { 

actualParamList$l .texlist  =  exp. typeAssignment : : 

actualParamList $2 . texlist ; 
exp. typeEnv  =  actualParamList $1 .typeEnv; 
actualParamList$2. typeEnv  =  ApplySubstToTypeEnv(exp.S, 

actualParamList$l .typeEnv) ; 
exp. letvars  =  actualParamList$l .letvars; 
actualParamList$2. letvars  =  actualParamList$l . letvars; 
exp . s  =  actualParamList$l .s ; 
actualParamList$2. s  =  exp.S; 
exp. encl  =  actualParamList$l . encl; 
actualParamList$2.encl  =  actualParamList$l .encl; 
exp. top  =  false; 
actualParamList$2.top  =  false; 
exp . sv  =  actualParamList$l . sv; 
actualParamList$2. sv  =  actualParamList$l . sv ; 
actualParamList$l .S  =  actualParamList$2 . S ; 
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>; 


actualParamList$l .partial  =  exp. partial  I  I 

actualParamLi  st$2 . part  ial ; 
exp .precedence  =  0; 
} 

I   ActualParamListNil  { 
actualParamList .texlist  =  TypeExpListNil; 
actualParamLi st .S  =  actualParamList .s; 
actualParamList .partial  =  false; 


term  :   Static,  Dynamic  { 

local  SUBST  fmalSubst; 

finalSubst  =  exp.S; 

exp.typeEnv  =  InitialEnvironment () ; 

exp . s  =  IdSubst ; 

exp.letvars  =  IdNullO  ::  LVNil; 

local  TYPESCHEME  f inalTypeScheme; 

f inalTypeScheme  = 

NonExpansive(exp)  ?  Close (NullTypeEnv, 
Re cReal( exp. type Assignment ,  exp.S)) 
:   TypeExp(RecReal(exp.typeAssignment ,  exp.S)); 
exp. top  =  true; 
exp.encl  =  false; 
exp.sv  =  SVNilO  ; 
} 


term  :   Static  [  ~  :  @  '7.n°/.S (PUNCTUATION :  :°/„S)  "  f inalTypeScheme  ] 
I   Dynamic  { 

local  exp  val; 

val  =  (exp.S  ==  FailSubst)  I  I  (exp. partial)  ? 
Ident (Identifier ("?")) 

:  let  EvalPair(v,  *)  =  eval(exp,  NullMem)  in  (v) ; 
} 
[  "  :  0  '"/.nval  "  val  "  °/„S  (PUNCTUATION :  :°/,S)  "  f  inalTypeScheme  ] 


exp  :   VoidExp  { 

exp.typeAssignment  =  TypeVar(WeakVar(newsymi()) ) ; 
exp . S  =  exp . s ; 
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exp. partial  =  true; 
} 

I   Refloc,  Varloc  {SYNSILENCE(exp)} 
I   I dent  { 

local  TYPESCHEME  binding; 

binding  =  LookupInTypeEnv(Id.name,  exp.typeEnv) ; 
exp.typeAssignment  =  Inst Scheme (binding) ; 
exp.S  =  binding  ==  TypeExp(UniversalType)  ? 

FailSubst  /*  Free  variables  cause  inconsistency  */ 
:  exp . s ; 
exp. partial  =  Id. partial; 
} 

I  Call  { 

local  TYPEVAR  beta; 

exp$2 .typeEnv  =  exp$l .typeEnv; 

exp$2 . s  =  exp$l . s; 

exp$2 . letvars  =  exp$l .letvars; 

actualParamList . letvars  =  exp$l .letvars; 

actualParamList . s  =  exp$2.S; 

actualParamList .typeEnv  =  ApplySubstToTypeEnv(exp$2 . S, 

exp$l .typeEnv) ; 

exp$l.S  =  Unify (exp$2 .typeAssignment , 

MapType (actualParamList .texlist ,  TypeVar(beta)) , 
actualParamList . S) ; 

beta  =  WeakVar(newsymiO)  ; 

exp$l .typeAssignment  =  TypeVar(beta) ; 

exp$l .partial  =  exp$2 .partial  I  I  actualParamList .partial; 

actualParamList . sv  =  exp$l.sv; 

exp$2.sv  =  exp$l.sv; 

actualParamList . encl  =  exp$l.encl; 

exp$2.encl  =  exp$l.encl; 

actualParamList .top  =  exp$l.top; 

exp$2.top  =  false; 

} 
I  Lambda  { 

local  TYPEEXPLIST  f ormalParamType; 

local  TYPEEXP  tau; 

f ormalParamType  =  GenerateTypeVars(f ormalParamList) ; 

exp$l .typeAssignment  =  tau; 

tau  =      Closed (FreeVarsIn(exp$l,    BVNil) ,    exp$l.sv)    ? 
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MapType(f ormalParamType,  exp$2 . typeAssignment) 
:  NullTypeO; 

exp$l.S  =  ((tau  ==  NullTypeO)  II 

MultipleOccurrenceIn(f ormalParamList))  ?  FailSubst () 

:  exp$2.S; 
exp$2 . s  =  exp$l . s; 
exp$2 .letvars  =  RemoveFPFromLVList(f ormalParamList , 

exp$l .letvars) ; 
exp$2 .typeEnv  =  TypeEnvConcatList (f ormalParamList , 

f ormalParamType ,  RemoveFPFromTypeEnv ( 
f ormalParamList ,  exp$l .typeEnv)) ; 
exp$l .partial  =  exp$ 2 .partial; 

exp$2.sv  =  RemoveFPFromSVList (f ormalParamList ,  exp$l.sv); 
exp$2.top  =  false; 
exp$2.encl  =  true; 


}; 


sparse  view  TypeErrors; 

exp  :   Ident   {  in  TypeErrors  on  (exp.S  ==  FailSubst) ;  } 
[  TypeErrors  @  :  "Id:  "  ~  '7,n"  ] 
I   Lambda   {  in  TypeErrors  on  (exp$l.S  ==  FailSubst  && 
exp$2.S  !=  FailSubst);  } 
[  TypeErrors  Q  :  "Lambda0/,n"  **  "  ] 


transform  term 

on  "eval-on" 

Static(e) 

when  ((! e. partial)  &&  (e.S  !=  FailSubst))  :  Dynamic (e) , 
on  "eval-off" 

Dynamic(e)  :  Static(e) 


/*  Return  the  free  variables  of  e  wrt  bound  variables  list  1  */ 
VLIST  FreeVarsIn  (exp  e,  VLIST  1)  { 
with  (e)  ( 

Ident (Ident if ier(x))  :  InVList (Identifier (x) ,  1)?  BVNil 
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}; 


AddrOf (e) 
Subscript (el ,  e2) 
Assign(el,  e2) 
PtrAdd(el,  e2) 
Deref (e) 


:  BVCons (Identifier (x) ,  BVNil)  , 
FreeVarsIn  (e,l), 

FreeVarsIn  (el,l)  @  FreeVarsIn  (e2,l)  , 
FreeVarsIn  (el,l)  @  FreeVarsIn  (e2,l)  , 
FreeVarsIn  (el,l)  @  FreeVarsIn  (e2,l)  , 
FreeVarsIn  (e,l), 
Lambda(f,  el)  :  FreeVarsIn  (el,  ConcatFormalParams(f ,  1)), 
Let (Identifier (x) ,  el,  e2)  :  FreeVarsIn  (el,l)  @ 

FreeVarsIn  (e2,Identif ier(x) : :1)  , 
LetVar(Identif ier(x) ,  el,  e2)  :  FreeVarsIn  (el,l)  0 

FreeVarsIn  (e2,Identif ier(x) : :1)  , 
LetArr(Identifier(x) ,el,e2)  :  FreeVarsIn  (el,l)  <S 

FreeVarsIn  (e2,Identif ier(x) : :1)  , 
Compose(el,  e2)  :  FreeVarsIn  (el,l)  @  FreeVarsIn  (e2,l), 
Not(el)  :  FreeVarsIn  (e,l), 

And (el,  e2)  :  FreeVarsIn  (el,l)  0  FreeVarsIn  (e2,l), 
Or(el,  e2)   :  FreeVarsIn  (el,l)  0  FreeVarsIn  (e2,l), 
Equal (el,  e2)  :  FreeVarsIn  (el,l)  @  FreeVarsIn  (e2,l), 
NotEquaKel,  e2)  :  FreeVarsIn  (el,l)  0  FreeVarsIn  (e2,l), 
Cond(el,  e2,  e3)  :  FreeVarsIn  (el,l)  @  FreeVarsIn  (e2,l)  @ 

FreeVarsIn  (e3,l), 
While(el,  e2)  :  FreeVarsIn  (el,l)  0  FreeVarsIn  (e2,l), 
Sum(el,  e2)    :  FreeVarsIn  (el,l)  @  FreeVarsIn  (e2,l), 


Diff(el,  e2) 
Prod(el,  e2) 
Quot(el,  e2) 


FreeVarsIn  (el,l)  @  FreeVarsIn  (e2,l), 
FreeVarsIn  (el,l)  @  FreeVarsIn  (e2,l), 
FreeVarsIn  (el,l)  0  FreeVarsIn  (e2,l), 
LessThan(el,  e2)  :  FreeVarsIn  (el,l)  @  FreeVarsIn(e2,l) , 
LessThanOrEqual(el ,  e2)  :  FreeVarsIn  (el,l)  @  FreeVarsIn(e2,l) , 
GreaterThan(el,  e2)  :  FreeVarsIn  (el,l)  @  FreeVarsIn(e2,l) , 
Great erThanOrEqual (el ,  e2)  :  FreeVarsIn  (el,l)  @  FreeVarsIn(e2,l) , 
Pair(el,  e2)  :  FreeVarsIn  (el,l)  @  FreeVarsIn(e2,l) , 
Call(e,a)     :  FreeVarsIn  (e,l)  0  FreeVarsInList (a,l) , 
default:  BVNil ()  /*  constants  and  placeholders  */ 


VLIST  ConcatFormalParams(formalParamList  1,  VLIST  bv)  { 
with(l)  ( 

FormalParamListPair(v,  rest)  :  ConcatFormalParams(rest , v  ::  bv)  , 

FormalParamListNil  :  bv 
) 

}; 
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/*  A  more  general  form  of  FreeVarsIn  for  finding  the 

*  free  variables  in  a  list  of  expressions. 
*/ 

VLIST  FreeVarsInList(actualParamList  1,  VLIST  bv)  { 
with(l)  ( 

ActualParamListPair(e,rest)  : 

FreeVarsIn(e,  bv)  @  FreeVarsInList (rest ,  bv) , 
default  :  BVNilQ 
) 

}; 

/*  Is  fv  a  subset  of  1 .  In  other  words,  we  check 

*  if  all  the  free  varibles  given  by  fv  occur  in  1 
*/ 

BOOL  Closed(VLIST  fv,  SVLIST  1)  { 
with(fv)  ( 

BVNil  :  true, 
BVCons(v,  rest)  : 

InSVList (v,  1)  ?  Closed(rest,  1) 
:  false 
) 

>; 

BOOL  InSVList  (Id  id,  SVLIST  1)  { 
with  (1)  ( 

SVNil  :  false, 

SVCons  (v,  rest)  :  (v  ==  id)  ?  true 
:  InSVList (id,  rest) 
) 
}; 


SVLIST  RemoveFromSVList  (Id  id,  SVLIST  1)  { 
with  (1)  ( 
SVNil  :  1, 

SVCons (v,  rest)  :  (v  ==  id)  ?  rest  : 
v  ::  RemoveFromSVList (id,  rest) 
) 

>; 
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?*  Remove  let/letvar/letarr  bound  variables  given 
*  1  from  b. 
*/ 
VLIST  RemoveLetbounds  (VLIST  b,  LVLIST  1)  { 
with  (b)  ( 

BVNilO  :  BVNilO, 
BVCons(v,  rest)  : 

InLVList(v,  1)  ?  v: : RemoveLetbounds  (rest,l) 
:  RemoveLetbounds  (rest,l) 
) 

}; 


/*  Generate  new  type  variables  for  the  formal  parameters 
*  of  a  function. 
*/ 
TYPEEXPLIST  GenerateTypeVars(f ormalParamList  1)  { 
with  (1)  ( 

FormalParamListPair(f ,  rest)  : 

TypeExpListPair(TypeVar(WeakVar(newsymi() )) , 
GenerateTypeVars(rest) ) , 
default  :  TypeExpListNil() 
) 

}; 

/*  Remove  the  formal  parameters  from  type  environment  */ 
TYPEENV  RemoveFPFromTypeEnv(f ormalParamList  1,  TYPEENV  t  )  { 
with(l)  ( 

FormalParamListPairddentif  ier(id)  ,  rest)  : 

RemoveFromTypeEnv(id,RenioveFPFromTypeEnv(rest ,  t))  , 
default  :  t 
) 
}; 


/*  Add  type  assumptions  for  the  formal  parameters  given  by  1 

*  to  the  type  environment.  Each  formal  parameter  f  in 

*  position  x  of  1 ,  is  associated  with  the  type  expression  given  in 

*  position  x  of  type  expression  list  e. 
*/ 

TYPEENV  TypeEnvConcatList(f ormalParamList  1,  TYPEEXPLIST  e, TYPEENV  t){ 
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with(l)  ( 

FormalParamListPair(Identif ier(id) ,  restl)  : 
with  (e)  ( 

TypeExpListPair(v,  rest2)  :  TypeEnvConcat (id,  TypeExp(v), 
TypeEnvConcatList (restl,  rest2,  t)), 
default  :  t 

), 

default  :  t 

) 

>; 


LVLIST  RemoveFPFromLVList(formalParamList  1,  LVLIST  lv)  { 
with(l)  ( 

FormalParamListPair(v,rest)  : 

RemoveFromLVList (v,RemoveFPFromLVList (rest ,  lv) ) , 
default  :  lv 
) 

>; 

SVLIST  RemoveFPFromSVList(f ormalParamList  1,  SVLIST  sv)  { 
with(l)  ( 

FormalParamListPair(v,rest)  : 

RemoveFromSVList (v ,RemoveFPFromSVList (rest ,  sv) ) , 
default  :  sv 
) 


/*  Functions  can  only  have  distinct  formal  parameters.  */ 
BOOL  MultipleOccurrenceIn(f ormalParamList  1)  { 
with(l)  ( 

FormalParamListNil  :  false, 
FormalParamListPair(x,  rest)  : 

Occur(x,  rest)  ?  true  :MultipleOccurrenceIn(rest) 
) 

}; 


BOOL  Occur (Id  x,  f ormalParamList  1)  { 
with(l)  ( 

FormalParamListNil  :  false, 
FormalParamListPair (y ,  rest)  : 
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(x  ==  y)  ?  true  :  Occur(x,  rest) 
) 

}; 

*  File  Name  :  let.ssl  * 

*  Purpose    :  let  and  letvar  declarations  * 

/*  Abstract  syntax */ 

exp  :    Let (Id  exp  exp) 

I   LetVar(Id  exp  exp) 


/*  Minimal  parenthesization  */ 

exp  :    Let ,  LetVar  { 

exp$2 .precedence  =  0; 

exp$3. precedence  =  0; 
> 


/*  Unparsing */ 

exp  :   Let  [  ~  ::=  ,,,/.{'/.L,/.S  (KEYWORD : let °/,S)  "  0  "  =  "  @ 

"  °/„S  (KEYWORD  :in°/,S)Mt°/.n"  0  "  MbMS  (KEYWORD :  end°/,S)0/„b°/„}"  ] 
I    LetVar   [  ~  :  :  =  ""/.{'/.L'/.S (KEYWORD:  let var°/,S)  "  @  "  :=  "  0 

"  °/.S  (KEYWORD  rin'/.sy/.tMn"  0  '"/.b'/.b'/.n'/S (KEYWORD :end0/0S)°/,b0/,}"  ] 


/*  Template  commands  */ 

transform  exp 

on  "let"  <exp>:  Let(<Id>,  <exp>,  <exp>) , 

on  "let<Id><exp>e"  e  when  (e  !=  <exp>) :  Let(<Id>,  <exp>,  e) , 

on  "let<Id>e<exp>"  e  when  (e  !=  <exp>) :  Let(<Id>,  e,  <exp>) , 

on  "letvar"  <exp> :  LetVar (<Id>,  <exp>,  <exp>) , 

on  "letvar<Id><exp>e"  e  when  (e  !=  <exp>)  :  LetVar(<Id>,  <exp>,  e) , 

on  "letvar<Id>e<exp>"  e  when  (e  !=  <exp>)  :  LetVar (<Id>,  e,  <exp>) 


/*  Concrete  input  syntax  */ 

Exp  ::=   (LET  id  >=>    Exp  IN  Exp  END)  { 

Exp$l.abs  =  Let(id.abs,  Exp$2.abs,  Exp$3.abs); 

} 
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(LETVAR  id  ASSIGN  Exp  IN  Exp  END)  { 

Exp$l.abs  =  LetVar(id.abs,  Exp$2.abs,  Exp$3.abs) 
} 


*  File  Name  :  let_inf er . ssl  * 

*  Purpose    :  Type  inference  for  let  and  letvar  * 

/* 

*  Two  local  attributes,  sigma  and  f inalTypeScheme,  are  needed  in  the 

*  attribution  of  Let;  sigma  is  used  to  extend  the  type  environment, 

*  while  f inalTypeScheme  gives  the  typing  used  in  the  alternative 

*  unparsing  rule.  Type  sigma  may  not  be  a  final  type  scheme  for 

*  Id. name  because  it  may  contain  type  variables  that  get  specialized 

*  by  an  enclosing  expression,  e.g,  letvar  x=[]  in 

*  let  y  =  (let  z=x  in  17)  in  l::x.  The  type  of  z  is  determined  by 

*  "l::x"  of  the  enclosing  expression  "let  y  =  ...". 

*  Thus  the  final  type  scheme  must  be  formed  from  the  final 

*  substitution  finalSubst  inherited  from  the  root.   This  is  done 

*  using  the  upward  remote  attribute  set  {Static. finalSubst, 

*  Dynamic. f inalSubst} . 
* 

*  If  attribute  f inalTypeScheme  is  used  for  both  purposes,  then  a 

*  type  2  circularity  results — there  is  a  mutual  dependence  between 

*  f inalTypeScheme  and  finalSubst. 
* 

*  Likewise  local  attribute  tau  of  LetVar,  used  in  the  alternative 

*  unparsing  rule,  must  also  be  formed  from  finalSubst. 
*/ 

exp  :   Let  { 

local  TYPESCHEME  sigma; 

local  TYPESCHEME  f inalTypeScheme; 

exp$l.S  =  exp$3.S; 

exp$l .typeAssignment  =  exp$3 .typeAssignment ; 

exp$l .partial  =  Id. partial  II  exp$2. partial  I  I  exp$3. partial; 

exp$2.s  =  exp$l.s; 

exp$2 . letvars  =  exp$ 1 . let vars ; 
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exp$3 .letvars  =  RemoveFromLVList (Id,  exp$l .letvars) ; 
exp$2 . typeEnv  =  exp$l . typeEnv ; 
exp$3.s  =  exp$2.S; 

exp$3 .typeEnv  =  TypeEnvConcat (Id .name ,  sigma, 
ApplySubstToTypeEnv(exp$2. S, 
RemoveFromTypeEnv ( Id . name ,  exp$ 1 . typeEnv) ) ) ; 
sigma  = 

NonExpansive(exp$2)  ? 

Close (ApplySubstToTypeEnv (exp$2 .S,  exp$l .typeEnv) , 

RecReal(exp$2 .typeAssignment,  exp$2.S)) 
:  TypeExp(RecReal(exp$2 .typeAssignment ,  exp$2.S)); 
f inalTypeScheme  = 

NonExpansive(exp$2)  ? 

Close (ApplySubstToTypeEnv ({Stat ic.f inalSubst , 
Dynamic. f inalSubst},  exp$l .typeEnv) , 
RecReal (exp$2. typeAssignment ,  {Stat ic.f inalSubst , 
Dynamic . f inalSubst}) ) 
:  TypeExp (RecReal (exp$2 . type Ass ignment , 
{Static .f inalSubst , Dynamic .f inalSubst}) ) ; 
exp$2.sv  =  exp$l.sv; 

exp$3.sv  =  exp$l.top  ?  exp$l.encl  ?  RemoveFromSVList (Id, 

exp$l . sv) 
:  SVCons(Id,exp$l.sv) 
:  exp$l.sv; 
exp$3 . encl  =  exp$ 1 . encl ; 
exp$2.encl  =  exp$l.encl; 
exp$2.top  =  false; 
exp$3.top  =  exp$l.top; 
}  ' 
I   LetVar  { 

local  TYPEEXP  tau; 

exp$l.S  =  exp$3.S; 

exp$l .typeAssignment  =  exp$3. typeAssignment ; 

exp$l .partial  =  Id. partial  I  I  exp$2 .partial  II  exp$3. partial ; 

exp$2 . s  =  exp$l . s ; 

exp$2 .letvars  =  exp$l . letvars; 

exp$3.  letvars  =  (Id  ==  IdNullO)  ?  exp$l .  letvars 

:  Id  : :  RemoveFromLVList (Id ,  exp$l . letvars) ; 
exp$2. typeEnv  =  exp$l .typeEnv; 
exp$3.s  =  FreeInLambda(Id.name,  exp$3)  ? 

Unif y(TypeVar(WeakVar(newsymi() )) , 
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exp$2.typeAssignment ,  exp$2.S) 
:  exp$2.S; 
exp$3.typeEnv  = 

TypeEnvConcat (Id. name,  TypeExp(exp$2.typeAssignment) , 
ApplySubstToTypeEnv(exp$3. s,  RemoveFromTypeEnv( 
Id. name,  exp$l .typeEnv))) ; 
/*  use  RecReal  here  only  because  alternative  unparsing  rule 

displays  type  tau  so  type  must  be  closed  */ 
tau  =  RecReal (exp$2 .typeAssignment ,  {Static .finalSubst , 

Dynamic. finalSubst}) ; 
exp$2.sv  =  exp$l.sv; 

exp$3.sv  =  exp$l.top  ?  exp$l.encl  ?  RemoveFromSVList (Id, 

exp$l . sv) 
:  SVCons(Id,exp$l .sv) 
:  exp$l.sv; 
exp$3.encl  =  exp$l.encl; 
exp$2.encl  =  exp$l.encl; 
exp$2.top  =  false; 
exp$3.top  =  exp$l.top; 


/*  Alternative  unparsing  */ 

exp  :    Let   [  "  ::=  ,7.{,/.L,/.S (KEYWORD :let'/.S)  "  0  ":"  f inalTypeScheme 
"  =  °/,o"  0  "  °/,S (KEYWORD  :iTL"/oS)%tlt%n"   0  '7.b0/.b°/,n 
%S  (KEYWORD :  end'/,S )  '/b0/,} "  ] 
I    LetVar   [  ~    :  :=  '"/.{'/.L'/.S (KEYWORD  :letvar°/„S)  "  0  ":" 

tau  "  var  :=  °/„o"  0  "  °/0S  (KEYWORD:  in'/.S)0^0^0^"  0 
" '/.b'/b'/n'/.S  (KEYWORD  :  end°/.b°/„S )  °/„} "  ] 


/*  Does  id  occur  free  in  a  \-abstraction  in  e?  */ 

BOOL  FreelnLambda  (ID  id,  exp  e)  { 
with  (e)  ( 

AddrOf(e)    :  FreeInLambda(id,  e) , 

Subscript (el,  e2)  : FreelnLambda (id,  el)  I  I  FreeInLambda(id,  e2) , 

Assign(el,  e2)   :  FreeInLambda(id,  el)  I  I  FreeInLambda(id,  e2) , 

PtrAdd(el,  e2)    :  FreelnLambda (id,  el)  I  I  FreeInLambda(id,  e2) , 

Deref(e)     :  FreeInLambda(id,  e) , 

Lambda(*,*)      :  Freeln(id,  e) , 
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Let(*,el,e2)      :  FreeInLambda(id,  el)  I  I  FreeInLambda(id,  e2)  , 
LetVar(*,el,e2)    :  FreeInLambda(id,  el)  I  I  FreeInLambda(id,  e2) , 
LetArr(*,el,e2)    :  FreeInLambda(id,  el)  I  I  FreelnLambdadd,  e2) , 
Compose(el ,e2)     :  FreeInLambda(id,  el)  II  FreelnLambdadd,  e2), 
Not(e)        :  FreeInLambda(id,  e) , 

And(el,e2)     :  FreelnLambdadd,  el)  I  I  FreeInLambda(id,  e2) , 
0r(el,e2)     :  FreeInLambda(id,  el)  ||  FreelnLambdadd,  e2) , 
Equal(el,e2)     :  FreelnLambdadd,  el)  II  FreelnLambdadd,  e2) , 
NotEqual (el ,e2)  :  FreelnLambdadd,  el)  II  FreelnLambdadd,  e2)  , 
Cond(el ,e2,e3)     :  FreelnLambdadd,  el)  I  I  FreeInLambda(id,  e2) 

II  FreeInLambda(id,  e3) , 
While(el,e2)     :  FreelnLambdadd,  el)  II  FreelnLambdadd,  e2)  , 
Sum(el,e2)     :  FreeInLambda(id,  el)  I  I  FreeInLambda(id,  e2)  , 
Diff(el,e2)     :  FreeInLambda(id,  el)  II  FreelnLambdadd,  e2)  , 
Prod(el,e2)     :  FreeInLambda(id,  el)  I  I  FreeInLambda(id,  e2) , 
Quot(el,e2)     :  FreeInLambda(id,  el)  II  FreeInLambda(id,  e2) , 
LessThan(el ,e2)  :  FreeInLambda(id,  el)  I  I  FreeInLambda(id,  e2)  , 
LessThan0rEqual(el,e2) : 

FreeInLambda(id,  el)  I  I  FreeInLambda(id,  e2)  , 
Great erThan (el ,e2)  :  FreeInLambda(id,  el)  I  I  FreeInLambda(id,  e2)  , 
GreaterThan0rEqual(el,e2)  :  FreeInLambda(id,  el)  I  I 

FreeInLambda(id,  e2) , 
Pair(el,e2)     :  FreeInLambda(id,  el)  II  FreeInLambda(id,  e2) , 
Call(e,l)    :  FreeInLambda(id,  e)   II  FreelnLambdaList (id,  1), 
default       :  false  /*  constants  and  placeholders  */ 
) 


}; 


BOOL  FreelnLambdaList (ID  id,  actualParamList  1)  { 
with(l)  ( 

ActualParamListPair(e,  rest)  : 

(FreeInLambda(id,  e)  I  I  FreelnLambdaList (id,  rest)), 
default  :  false 
) 

}; 

BOOL  Freeln  (ID  id,  exp  e)  {  /*  Does  id  occur  free  in  e?  */ 
with  (e)  ( 
Ident (Identifier (x))  :  id  ==  x, 
AddrOf(e)    :  Freeln(id,  e) , 

Subscript (el,  e2)  :FreeIn(id,  el)  I  I  Freeln(id,  e2) , 
Assign(el,  e2)  :  Freeln(id,  el)  I  I  Freeln(id,  e2) , 
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}; 


PtrAdd(el,  e2)    :  Freeln(id,  el)  II  Freeln(id,  e2)  , 
Deref(e)  :  Freeln(id,  e) , 

Lambda(f,  el)  :  !  OccursIn(id,  f)  &&  Freeln(id,  el), 
Let (Identifier (x) ,  el,  e2)  :  Freeln(id,  el)  I  I 

(Freeln(id,  e2)  &&  id  !=  x) , 
LetVar(Identif ier(x) ,  el,  e2)  :  Freeln(id,  el)  I  I 

(Freeln(id,  e2)  &&  id  !=  x) , 
LetArr(*,el,e2)    :  Freeln(id,  el)  I  I  Freeln(id,  e2) , 
Compose(el,  e2)  :  Freeln(id,  el)  I  I  Freeln(id,  e2) , 
Not(el)  :  Freeln(id,  el), 

And(el,  e2)  :  Freeln(id,  el)  ||  Freeln(id,  e2) , 
Or(el,  e2)  :  Freeln(id,  el)  ||  Freeln(id,  e2) , 
Equal(el,  e2)  :  Freeln(id,  el)  I  I  Freeln(id,  e2) , 
NotEqual(el,  e2)  :  Freeln(id,  el)  I  I  Freeln(id,  e2) , 
Cond(el,  e2,  e3)  :  Freeln(id,  el)  ||  Freeln(id,  e2)  II 

Freeln(id,  e3) , 
While(el,  e2)  :  Freeln(id,  el)  ||  Freeln(id,  e2) , 
Sum(el,  e2)  :  Freeln(id,  el)  I  I  Freeln(id,  e2) , 


Diff(el,  e2) 
Prod(el,  e2) 
Quot(el,  e2) 


Freeln(id,  el)  II  Freeln(id,  e2) , 
Freeln(id,  el)  II  Freeln(id,  e2) , 
Freeln(id,  el)  ||  Freeln(id,  e2) , 
LessThan(el,  e2)  :  Freeln(id,  el)  I  I  Freeln(id,  e2) , 
LessThanOrEqual(el,  e2)  :  Freeln(id,  el)  II  Freeln(id,  e2) , 
Great erThan (el,  e2)  :  Freeln(id,  el)  II  Freeln(id,  e2) , 
Great erThanOrEqual (el,  e2)  :  Freeln(id,  el)  I  I  Freeln(id,  e2) , 
Pair(el,  e2)  :  Freeln(id,  el)  ||  Freeln(id,  e2) , 
Call(e,l)    :  Freeln(id,e)  I  I  FreeInList(id,  1), 
default:  false  /*  constants  and  placeholders  */ 
) 


BOOL  OccursIn(ID  id,  f ormalParamList  1)  { 
with  (1)  ( 

FormalParamListPair(Identif ier(x) ,  rest)  : 

((x  ==  id)  ||  OccursIn(id,  rest)), 
default  :  false 
) 

h 

BOOL  FreeInList(ID  id,  actualParamList  1)  { 
with(l)  ( 

ActualParamListPair(e,  rest)  : 
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(Freeln(id,  e)  II  FreelnList (id,  rest)), 
default  :  false 
) 

>; 


*  File  Name  :  letarr.ssl  * 

*  Purpose    :  Definitions  for  letarr,  pointer  arithmetic  and  * 

*  array  indexing.  We  make  a  minor  change  to  Poly  C  * 

*  syntax  and  denote  pointer  arithmetic  with  special  * 

*  character  \oplus  which  is  a  plus  sign  +  and  a  circle  * 

*  around  it.  But  in  template  panel  of  the  editor  this  * 

*  sign  will  be  seen  as  o+  because  the  current  SynGen  * 

*  environment  can  not  display  this  special  character  * 

*  appropriately.  * 

/*  Abstract  syntax */ 

exp  :    LetArr(Id  exp  exp) 
I    PtrAdd(exp  exp) 
I    Subscript (exp  exp) 
I    SubscriptL(exp  exp)  /*  For  internal  use  only.  */ 


/*  Minimal  parenthesization  */ 

exp  :   LetArr  { 

exp$2 .precedence  =  0; 
exp$3. precedence  =  0; 
} 
I   PtrAdd  PP2(6) 
I   Subscript  PP2(0) 


/*  Unparsing */ 

exp  :   LetArr  [  ~  :  :=  "°/,S (KEYWORD :letarr'/.S)  "  0  "["(§"]" 

"  °/,S  (KEYWORD  :in%S)°/,t°/.t'/,n"  6  "0/„b0/„b0/0n°/,S  (KEYWORD :  end°/„S)  "  ] 
I   PtrAdd  [  ~  ::=  '7.{"  "°/.S (PUNCTUATION:"  lp  '7„S)"  8  "°/„S (OPERATOR: 

\<oplus>°/.S)0/.o  "  8  "°/,S (PUNCTUATION:"  rp  "%S)X}"  1 
I   Subscript     [  "  :  :=   "•/.{"  @  "  ["  8  "]0/.}"  ] 
I   SubscriptL     [  "  :  :=   M,/.{"  8  "  ["  8  "]'/.}"  ] 
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/*  Template  commands  */ 

transform  exp 

on  "letarr"  <exp>:  LetArr(<Id>,  <exp> ,  <exp>) , 

on  "letarr<Id><exp>e"  e  when  (e  !=  <exp>) :  LetArr(<Id>,  <exp>,  e)  , 

on  "letarr<Id>e<exp>"  e  when  (e  !=  <exp>) :  LetArr(<Id>,  e,  <exp>) , 

on  "\<oplus>"  <exp>  :  PtrAdd(<exp>  ,  <exp>) , 

on  "[  ]"  <exp>  :  Subscript (<exp>,  <exp>) 


/*  Concrete  input  syntax  */ 

Exp  ::=  (LETARR  id  ' ['Exp']'  IN  Exp  END)  { 

Exp$l.abs  =  LetArr(id.abs,  Exp$2.abs,  Exp$3.abs); 
} 
I    (Exp  PTRADD  Exp)  {Exp$l.abs  =  PtrAdd(  Exp$2.abs,  Exp$3.abs);  } 
I    (Exp  '['Exp']')  {Exp$l.abs  =  Subscript (Exp$2 . abs,  Exp$3.abs);} 


*  File  Name  :  letarr. ssl  * 

*  Purpose   :  Type  inference  for  letarr,  pointer  arithmetic  and    * 

*  array  indexing.  * 

exp  :   LetArr  { 

exp$l.S  =  exp$3.S; 

exp$l .typeAssignment  =  exp$3 .typeAssignment ; 

exp$l .partial  =  Id. partial  I  I  exp$2 .partial  I  I  exp$3. partial; 

exp$2.s  =  exp$l.s; 

exp$2 . letvars  =  exp$l . letvars; 

exp$3.1etvars  =  RemoveFromLVList (Id,  exp$l . letvars) ; 

exp$2.typeEnv  =  exp$l .typeEnv; 

exp$3.s  =  Unify (exp$2 .typeAssignment ,Int Type, exp$2.S) ; 

exp$3. typeEnv  = 

TypeEnvConcat ( Id . name ,  TypeExp (Ref Type (TypeVar ( 
WeakVar(newsymiO) )) ) ,  ApplySubstToTypeEnv(exp$2 .S , 
RemoveFromTypeEnv(Id.name,  exp$l .typeEnv)) ) ; 
exp$2.sv  =  exp$l.sv; 
exp$3.sv  =  exp$l.top  ?  exp$l.encl  ? 

RemoveFromSVList (Id,  exp$l.sv) 
:  SVCons(Id,exp$l.sv) 
:  exp$l.sv; 


101 


exp$3.encl  =  exp$l.encl; 

exp$2.encl  =  exp$l.encl; 

exp$2.top  =  false; 

exp$3.top  =  exp$l.top; 
} 
PtrAdd  { 

exp$2 .typeEnv  =  exp$l .typeEnv; 

exp$2 .letvars  =  exp$l .letvars; 

exp$3.1etvars  =  exp$l .letvars; 

exp$2 . s  =  exp$l . s; 

exp$3.s  =  Unify(RefType(TypeVar(WeakVar(newsymi()))) , 
exp$2 .typeAssignment ,  exp$2.S); 

exp$3. typeEnv  =  ApplySubstToTypeEnv(exp$3.s,  exp$l .typeEnv) ; 

exp$l.S  =  Unify (exp$3. typeAssignment,  IntType,  exp$3.S); 

exp$l .typeAssignment  = 

ApplySubstToTypeExp(exp$l .S,  exp$2 .typeAssignment) ; 

exp$l .partial  =  exp$2 .partial  I  I  exp$3. partial; 

exp$3 . encl  =  exp$ 1 . encl ; 

exp$2.encl  =  exp$l.encl; 

exp$2.top  =  false; 

exp$3.top  =  exp$l.top; 

exp$2.sv  =  exp$l.sv; 

exp$3 . sv  =  exp$l.sv; 
} 
Subscript  { 

local  TYPEEXP  tau; 

exp$2. typeEnv  =  exp$l .typeEnv; 

exp$2. letvars  =  exp$l .letvars; 

exp$3. letvars  =  exp$l .letvars; 

exp$2.s  =  exp$l.s; 

exp$3.s  =  Unify(RefType(TypeVar(WeakVar(newsymi())) ) , 
exp$2 .typeAssignment ,  exp$2.S); 

exp$3. typeEnv  =  ApplySubstToTypeEnv(exp$3.s ,  exp$l .typeEnv) ; 

exp$l.S  =  Unify (exp$3 .typeAssignment ,  IntType,  exp$3.S); 

exp$l .typeAssignment  = 
with(tau)  ( 

RefType(t)  :  t, 
default    :  NullType 

); 

exp$l .partial  =  exp$2 .partial  I  I  exp$3. partial ; 

tau  =  ApplySubstToTypeExp(exp$l . S ,  exp$2 .typeAssignment) ; 

exp$3 . encl  =  exp$ 1 . encl ; 
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exp$2.encl  =  exp$l.encl; 

exp$2.top  =  false; 

exp$3.top  =  exp$l.top; 

exp$2.sv  =  exp$l.sv; 

exp$3 . sv  =  exp$l.sv; 
} 
I    SubscriptL  { 

INHSILENCE(exp$2)  /*  this  attribution  is  a  result  */ 

INHSILENCE(exp$3)  /*  of  values  being  expressions  */ 

SYNSILENCE(exp$l) 
} 


/*  Alternative  unparsing  */ 

exp  :   PtrAdd  { 

in  TypeErrors  on  (exp$l.S  ==  FailSubst  && 

exp$2.S  !=  FailSubst  &&  exp$3.S  !=  FailSubst); 
}    [  TypeErrors  0  :  "PtrAdd°/,n"  ~  *  ] 
I   Subscript  { 

in  TypeErrors  on  (exp$l.S  ==  FailSubst  && 
exp$2.S  !=  FailSubst); 
}    [  TypeErrors  <§  :  "  Subscript  •/.n"  ~  ~  ] 


*  File  Name  :  lex.ssl  * 

*  Purpose    :  Lexical  syntax,  token  precedences  for  concrete  input   * 

*  syntax  and  style  declarations.  * 

/*  Lexical  syntax */ 

WHITESPACE   :     WhiteSpaceLex   <  [\  \t\n]  >; 
EXP.PLACEHOLDER:   ExpPlaceholderLex  <  M<exp>"  >; 

IDEMTIFIER.PLACEHOLDER:   Identif ierPlaceholderLex  <  "<identif ier>"  >; 
LAMBDA      :   LambdaLex   <  "lambda" I "LAMBDA" I {lambda}  >; 
VAL         :   ValLex      <  "val"|"VAL"  >; 
FIX         :   FixLex      <  "fix"  >; 
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LET 

:    LetLex 

LETVAR 

:    LetVarLex 

LETARR 

LetArrLex 

IN 

InLex 

NIL 

NilLex 

IF 

IfLex 

WHILE 

WhileLex 

UNIT 

UnitLex 

THEN 

ThenLex 

ELSE 

ElseLex 

DO 

DoLex 

OD 

OdLex 

FI 

FiLex 

BEGIN 

BeginLex 

END 

EndLex 

TRUE 

TrueLex 

FALSE 

FalseLex 

ASSIGN 

AssignLex 

LOGICALAND 

LogicalAnd 

LOGICALOR 

LogicalOr 

NOTEQUAL 

NotEqualLex 

LESSEQUAL 

LessEqualLe 

GREATEREQUAL 

:    GreaterEqua 

INTEGER 

IntegerLex 

FLOAT       : 

FloatLex 

ID          : 

IdLex 

PTRADD      : 

PtrAddLex 

<  "let"   >; 

<  "letvar"   >; 

<  "letarr"   >; 

<  "in" I "IN"   >; 

<  "nil"!"  []"  >; 

<  "if'T'IF"  >; 

<  "while" |"WHILE"  >; 

<  "unit"   >; 

<  "then" I "THEN"  >; 

<  "else'T'ELSE"   >J 

<  "do" | "DO"  >: 

<  "od"|"0D"   > 

<  "fi" | "FI"   > 

<  "begin" I "BEGIN"  >; 

<  "end'T'END"  >; 

<  "true" | "TRUE"  >; 

<  "false" | "FALSE"  >; 

<  ":="   >; 

<  "&&"   >; 

<  "II"   > ; 
<    "<>"|{ne}  >; 

x       <   "<="Kle}  >; 
lLex        <   ">="|{ge}  >; 

<  \-?[0-9]+  >; 

<  [0-9]  *  (\  .  [0-9]  *)  (  [dDeE]  [-+]  ?  [0-9]  +)  7> ; 

<  [A-Za-z] [0-9A-Za-z_$] *[']*| [?]   >; 

<  {oplus}  >; 


/*  Token  precedences  for  concrete  input  syntax  */ 

left  LOGICALOR; 

left  LOGICALAND; 

nonassoc  NOTEQUAL; 

nonassoc  '=',  ><>,   LESSEQUAL,  '>' ,   GREATEREQUAL; 

left  PTRADD,  '+; ,  '-'; 

left  '*>  ,  '/'; 

right  ' & ' ,  » ! ' ,  >~>  ; 

nonassoc  ID,  VAL,  FIX,  IN,  NIL,  TRUE,  FALSE,  FLOAT,  INTEGER,  LET, 
LETVAR, LETARR,  IF,  WHILE,  UNIT,  THEN,  ELSE,  DO,  OD,  FI , 
BEGIN,  END,  ASSIGN,  LAMBDA,  EXP_PLACEHOLDER  ; 
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/*  Style  declarations  */ 

style  NORMAL,  KEYWORD,  PLACEHOLDER,  PUNCTUATION,  OPERATOR; 


*  File  Name  :  newsymi.c  * 

*  Purpose    :  New  type  variable  generator.  * 

/*  $Revision:  1.2  $ 

*  $Date:  1993/09/02  21:21:12  $ 

*  $Author:  volpano  $ 

*  $Log:  newsymi.c, v  $ 

*  Revision  1.2   1993/09/02  21:21:12  volpano 

*  Removed  T  in  sprintf . 
* 

*/ 
/* 

*  Copyright  (c)  1989,  an  unpublished  work  by  GrammaTech,  Inc. 

*  ALL  RIGHTS  RESERVED 
* 

*  This  software  is  furnished  under  a  license  and  may  be  used  and 

*  copied  only  in  accordance  with  the  terms  of  such  license  and  the 

*  inclusion  of  the  above  copyright  notice.  This  software  or  any 

*  other  copies  thereof  may  not  be  provided  or  otherwise  made 

*  available  to  any  other  person.   Title  to  and  ownership  of  the 

*  software  is  retained  by  GrammaTech,  Inc. 
*/ 

#include  "str0_exp.h" 
#include  "structures_exp.h" 
#include  "types_exp .h" 

/* 

*  newsymi 

* 

*  Generate  new  unique  symbol. 

* 

*  WARNING:   In  general,  this  is  not  a  good  technique,  because 

*  gratuitous  new  symbols  will  cause  AFFECTED  to  be  too  large. 
*/ 
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FOREIGN  newsymiO 
{ 

static  int  i; 

static  char  buff  [10]; 

sprintf  (buff  ,  "*°/,d"  ,i++) ; 
return(Str(str_to_strO(buff))) ; 
} 


*  File  Name  :  pair.ssl                                         * 

*  Purpose  :  Defitions  for  pair.  Pair  is  the  stdout  of  the         * 

*  interpreter.  We  output  the  result  produced  by  a  * 

*  program  through  pair  construct.  One  might  consider    * 

*  using  list  construct  for  this  purpose.  But  a  list  * 

*  requires  the  elements  have  the  same  which  is  a  severe  * 

*  restriction.  Notice  that  we  define  only  the  required  * 

*  constructor  and  do  not  define  first  and  second  * 

*  operations  since  pair  is  not  in  Poly  C  calculus  they  * 

*  are  not  needed.  * 

/*  Abstract  syntax */ 

exp  :   Pair(exp  exp) 


/*  Minimal  parenthesization  */ 

exp  :   Pair  { 

exp$2 .precedence  =  0; 

exp$3 .precedence  =  0; 
} 


/*  Unparsing */ 

exp  :    Pair    [  "  ::=  '7„S (PUNCTUATION :  (7.S) "  0 

'7.S(  PUNCTUATION  :,'/.S)  %o"      @  '7,S  (PUNCTUATION:  )°/.S)  "  ] 


/*  Template  commands  */ 

transform  exp 
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on  " (  ,  )"  <exp>  :  Pair(<exp>,<exp>) 


/*  Concrete  input  syntax  */ 

Exp  ::=   ('('  Exp  ','    Exp  ')')    {$$.abs  =  Pair (Exp$2 . abs ,  Exp$3.abs);} 


*  File  Name  :  pair_inf er . ssl  * 

*  Purpose    :  Type  inference  for  pair.  * 

exp  :   Pair     { 

exp$2.typeEnv  =  exp$l .typeEnv; 

exp$2.1etvars  =  exp$l .letvars; 

exp$3.1etvars  =  exp$l .letvars; 

exp$2.s  =  exp$l.s; 

exp$3. typeEnv  =  ApplySubstToTypeEnv(exp$2.S,  exp$l .typeEnv) ; 

exp$3.s  =  exp$2.S; 

exp$l .partial  =  exp$2 .partial  I  I  exp$3 .partial; 

exp$l.S  =  exp$3.S; 

exp$l .typeAssignment  =  PairType(exp$2 . typeAssignment , 

exp$3.typeAssignment) ; 
exp$3.top  =  false; 
exp$2.top  =  false; 
exp$3.encl  =  exp$l.encl; 
exp$2.encl  =  exp$l.encl; 
exp$3.sv  =  exp$l.sv; 
exp$2.sv  =  exp$l.sv; 
} 


*  File  Name  :  real. ssl  * 

*  Purpose    :  Definitions  for  real  numbers.  * 

/*  Abstract  syntax */ 
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exp  :   RealOp(REAL)    [ 


/*  Concrete  input  syntax  */ 

Exp  ::=   (FLOAT)  {  Exp$l.abs  =  RealOp (STRtoREAL (FLOAT) ) ;  } 


*  File  Name  :  real_inf er .ssl  * 

*  Purpose    :  Type  inference  for  real  numbers.  * 

exp  :   RealOp  { 

exp.typeAssignment  =  RealType; 
exp.S  -=  exp .  s; 
exp. partial  =  false; 
} 


*  File  Name  :  while. ssl  * 

*  Purpose    :  Definitions  for  while  loop.  * 

+  +  +  +  +  +  +  +  +  +  ^  +  +  +  +  !t:^  +  +  ^  +  ^  +  +  +  *  +  **  +  +  ***^  +  *******  +  +  ***  +  +  **  +  ***************/ 

/*  Abstract  syntax */ 

exp  :   While (exp  exp)  ; 

/*  Minimal  parenthesization  */ 

exp  :   While  { 

exp$2 .precedence  =  0; 

exp$3. precedence  =  0; 
} 


/*  Unparsing */ 

exp  :   While  ["  ::=  "MS  (KEYWORD  :while°/„S)  "  ®  "  7.S  (KEYWORD  :do'/.S)\n" 
<3  '"/.b'/.n'/.S (KEYWORD :od*/.S)"] 


/*  Template  commands  */ 

transform  exp 
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on  "while"  e  :  While(<exp>,  e) 


/*  Concrete  input  syntax  */ 

Exp  : :=    (WHILE  Exp  DO  Exp  OD) 

{  Exp$l.abs  =  While (Exp$2.abs,  Exp$3.abs);  } 


*  File  Name  :  while_inf er . ssl  * 

*  Purpose    :  Type  inference  for  while  loop.  * 

/*  type  inference  */ 
exp  :   While  { 

exp$2.typeEnv  =  exp$l .typeEnv; 

exp$2.1etvars  =  exp$l .letvars; 

exp$3.1etvars  =  exp$l .letvars; 

exp$2.s  =  exp$l.s; 

exp$3.s  =  Unify (exp$2 .type Assignment ,  IntType,  exp$2.S); 

exp$3. typeEnv  =  ApplySubstToTypeEnv(exp$3. s,  exp$l .typeEnv) ; 

exp$l.S  =  exp$3.S; 

exp$l .typeAssignment  =  UnitType; 

exp$l .partial  =  exp$2 .partial  I  I  exp$3 .partial; 

exp$3 . encl  =  exp$ 1 . encl ; 

exp$2.encl  =  exp$l.encl; 

exp$3.sv  =  exp$l.sv; 

exp$2.sv  =  exp$l.sv; 

exp$2.top  =  false; 

exp$3.top  =  false; 


exp  :   While 

{  in  TypeErrors  on  (exp$3.s  ==  FailSubst  && 

exp$2.S  !=  FailSubst);  } 
[  TypeErrors  @  :  "While'/.n"  ""  "  ] 
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